void get_CI95(double *hat_95, const double *to_be_sorted, size_t *index_sorted, double *weights)
{
int k;
double weight_cum;
double invJ = 1.0/ ((double) J);
//get the index of to_be_sorted.
gsl_sort_index(index_sorted, to_be_sorted, 1, J); //to_be_sorted is not modified (i.e. not sorted in place), the index of the sorting are put in index_sorted.
//cumulate sorted weight until we reach 2.5 % and take the corresponding value in to_be_sorted
k=0;
weight_cum = 0.0;
while(weight_cum < 0.025) {
weight_cum += (weights) ? weights[index_sorted[k]]: invJ;
k++;
}
hat_95[0] = to_be_sorted[index_sorted[((k-1) <0) ? 0 : k-1]];
//cumulate sorted weight until we reach 97.5 % and take the corresponding value in to_be_sorted
k=0;
weight_cum = 0.0;
while(weight_cum < 0.975) {
weight_cum += (weights) ? weights[index_sorted[k]]: invJ;
k++;
}
hat_95[1] = to_be_sorted[index_sorted[((k-1) <0) ? 0 : k-1]];
}
int Filter::sortedCurveData(QwtPlotCurve *c, double start, double end, double **x, double **y)
{
if (!c)
return 0;
int i_start = 0, i_end = 0;
int n = curveRange(c, start, end, &i_start, &i_end);
(*x) = new double[n];
(*y) = new double[n];
double *xtemp = new double[n];
double *ytemp = new double[n];
int j=0;
for (int i = i_start; i <= i_end; i++){
xtemp[j] = c->x(i);
ytemp[j++] = c->y(i);
}
size_t *p = new size_t[n];
gsl_sort_index(p, xtemp, 1, n);
for (int i=0; i<n; i++){
(*x)[i] = xtemp[p[i]];
(*y)[i] = ytemp[p[i]];
}
delete[] xtemp;
delete[] ytemp;
delete[] p;
return n;
}
void reordenar_importance(edge *my_edge,size_t *imp_index,int Nedges)//devuelve el vector de indices de importancia cambiado
{
double *importance;
importance=(double*)calloc(Nedges,sizeof(double));
for (int i=0;i<Nedges;i++) importance[i]=my_edge[i].importance*1.;
gsl_sort_index(imp_index,importance,1,Nedges); //ya tenemos ordenados los edges por importancia, y su antiguo nombre esta en index
free(importance);
return;
}
int
main (int argc, char **argv)
{
(void)(argc); /* avoid unused parameter warning */
int i, n = 256, nc = 20;
double *data = malloc (n * sizeof (double));
double *abscoeff = malloc (n * sizeof (double));
size_t *p = malloc (n * sizeof (size_t));
FILE * f;
gsl_wavelet *w;
gsl_wavelet_workspace *work;
w = gsl_wavelet_alloc (gsl_wavelet_daubechies, 4);
work = gsl_wavelet_workspace_alloc (n);
f = fopen (argv[1], "r");
for (i = 0; i < n; i++)
{
fscanf (f, "%lg", &data[i]);
}
fclose (f);
gsl_wavelet_transform_forward (w, data, 1, n, work);
for (i = 0; i < n; i++)
{
abscoeff[i] = fabs (data[i]);
}
gsl_sort_index (p, abscoeff, 1, n);
for (i = 0; (i + nc) < n; i++)
data[p[i]] = 0;
gsl_wavelet_transform_inverse (w, data, 1, n, work);
for (i = 0; i < n; i++)
{
printf ("%g\n", data[i]);
}
gsl_wavelet_free (w);
gsl_wavelet_workspace_free (work);
free (data);
free (abscoeff);
free (p);
return 0;
}
static VALUE rb_gsl_sort_index_narray(VALUE obj)
{
struct NARRAY *na;
size_t size, stride;
double *ptr1;
gsl_permutation *p;
GetNArray(obj, na);
ptr1 = (double*) na->ptr;
size = na->total;
stride = 1;
p = gsl_permutation_alloc(size);
gsl_sort_index(p->data, ptr1, stride, size);
return Data_Wrap_Struct(cgsl_permutation, 0, gsl_permutation_free, p);
}
int Interpolation::sortedCurveData(QwtPlotCurve *c, double start, double end, double **x, double **y)
{
if (!c || c->rtti() != QwtPlotItem::Rtti_PlotCurve)
return 0;
int i_start = 0, i_end = c->dataSize();
for (int i = 0; i < i_end; i++)
if (c->x(i) > start && i)
{
i_start = i - 1;
break;
}
for (int i = i_end-1; i >= 0; i--)
if (c->x(i) < end && i < c->dataSize())
{
i_end = i + 1;
break;
}
int n = i_end - i_start + 1;
(*x) = new double[n];
(*y) = new double[n];
double *xtemp = new double[n];
double *ytemp = new double[n];
double pr_x;
int j=0;
for (int i = i_start; i <= i_end; i++)
{
xtemp[j] = c->x(i);
if (xtemp[j] == pr_x)
{
delete (*x);
delete (*y);
return -1;//this kind of data causes division by zero in GSL interpolation routines
}
pr_x = xtemp[j];
ytemp[j++] = c->y(i);
}
size_t *p = new size_t[n];
gsl_sort_index(p, xtemp, 1, n);
for (int i=0; i<n; i++)
{
(*x)[i] = xtemp[p[i]];
(*y)[i] = ytemp[p[i]];
}
delete[] xtemp;
delete[] ytemp;
delete[] p;
return n;
}
/** \brief Quantile-normalize an input vector to a standard normal.
* \note Missing values should be removed beforehand.
* \note code inspired from "qqnorm" in GNU R.
*/
void qqnorm(double * ptData, const size_t n)
{
size_t * order = (size_t*) calloc(n, sizeof(size_t));
if (order == NULL) {
fprintf(stderr, "ERROR: can't allocate memory for order in qqnorm\n");;
exit(1);
}
gsl_sort_index(order, ptData, 1, n);
double q, a = (n <= 10 ? 0.375 : 0.5);
for (size_t i=0; i<n; ++i) {
q = (i+1 - a) / (n + 1 - 2 * a);
ptData[order[i]] = gsl_cdf_ugaussian_Pinv(q);
}
free(order);
}
/*-------------------- ut_mean ----------------------*/
double ut_mode2(double* val,int n){
/* This function returns the highest probability density a set of
datas. This only works reliabely if there is only 1 maximum,
and in the limit where the data is sufficiently sampled.
No error computation is performed ...*/
/* The search is dyadic and iterative, each step looking for the part
which contains most of the data with respect to the highest value.
The time is O(NlnN) (+ the time to run indexx)*/
/* This is a fast and inaccurate algorithm. For a general algorithm, see the
Parzenwindow method - the drawback is that it depends on a window size
a priori*/
size_t * index;
double half;
int nmin=0;
int nmax=n; /* out of the table */
index = malloc(n*sizeof(size_t));
/* test */
gsl_sort_index(index,val,1,n);
do {
int i;
/* half window computation */
half=(val[index[nmin]]+val[index[nmax-1]])/2;
for (i=nmin;i<nmax;i++) {
if (val[index[i]]>half)
break;
}
if (i==nmax)
return half;
else if (i<nmin+(nmax-nmin)/2)
nmin=i;
else if (i>nmin+(nmax-nmin)/2 || ((nmax-nmin)%2) )
nmax=i;
else {
nmin++;
nmax--;
}
} while (nmax-nmin>2);
return half;
}
/*-------------------- ut_mean ----------------------*/
double ut_mode(double* val,int n){
/* This function returns the highest probability density a set of
datas. This only works reliabely if there is only 1 maximum,
and in the limit where the data is sufficiently sampled.
No error computation is performed ...*/
/* The search is dyadic and iterative, each step looking for the part
where the median is the narrower. The time is O(NlnN) (+ the time to run
indexx)*/
/* This is a fast and inaccurate algorithm. For a general algorithm, see the
Parzenwindow method - the drawback is that it depends on a window size
a priori*/
size_t * index;
double med;
int nmin=0;
int nmax=n; /* out of the table */
index = malloc(n*sizeof(size_t));
/* test */
gsl_sort_index(index,val,1,n);
do {
/* median computation */
if ((nmax-nmin) % 2 == 0)
med = (val[index[ (nmin + nmax )/2 ]] + val[index[ (nmin+nmax)/2 -1 ]])/2;
else
med = val[index[ (nmin + nmax)/2 ]];
/* The density is higher for the upper part */
if ( fabs(med - val[index[nmin]]) > fabs (med - val[index[nmax-1]]) )
nmin =(nmin + nmax - 1 )/2;
else if ( fabs(med - val[index[nmin]]) < fabs (med - val[index[nmax-1]]) )
/* rounding in the good direction in order to include the median place */
nmax = ( nmin + nmax)/2 + 1;
else /* stop in case of equality */
nmax = nmin;
} while (nmax-nmin > 2);
return med;
}
/*
* Rank data using the natural ordering on doubles, ties being resolved by taking their average.
*
* Source: http://commons.apache.org/math/apidocs/src-html/org/apache/commons/math/stat/ranking/NaturalRanking.html#line.190
*/
void rsSpearmannRank(double *ranks, const double *data, const size_t n) {
size_t i;
double *d = malloc(sizeof(double)*n);
size_t *p = malloc(sizeof(size_t)*n);
// copy the input data and sort them
for(i=0; i<n; ++i)
d[i] = data[i];
gsl_sort(d, 1, n);
// get the index of the input data as if they were sorted
gsl_sort_index(p, data, 1, n);
// walk the sorted array, filling output array using sorted positions, resolving ties as we go
size_t pos = 1;
ranks[p[0]] = pos;
size_t n_ties = 1;
size_t * tiesTrace = (size_t*) calloc (1, sizeof(size_t));
tiesTrace[0] = p[0];
for(i=1; i<n; ++i) {
if(d[i] - d[i-1] > 0) {
pos = i + 1;
if(n_ties > 1) {
rsRankingResolveTies(ranks, tiesTrace, n_ties);
}
tiesTrace = (size_t*) realloc(tiesTrace, sizeof(size_t));
n_ties = 1;
tiesTrace[0] = p[i];
} else {
++n_ties;
tiesTrace = (size_t*) realloc(tiesTrace, n_ties * sizeof(size_t));
tiesTrace[n_ties-1] = p[i];
}
ranks[p[i]] = pos;
}
if(n_ties > 1) {
rsRankingResolveTies(ranks, tiesTrace, n_ties);
}
free(tiesTrace);
free(d);
free(p);
}
void BaselineDialog::subtractBaseline(bool add)
{
if (!d_baseline)
return;
disableBaselineTool();
if (!graph)
return;
int index = graph->curveIndex(boxInputName->currentText());
DataCurve *c = graph->dataCurve(index);
if (!c)
return;
ApplicationWindow *app = (ApplicationWindow *)parent();
if (!app)
return;
Table *inputTable = c->table();
if (!inputTable)
return;
int inputPoints = inputTable->numRows();
QString xColName = c->xColumnName();
int xCol = inputTable->colIndex(xColName);
int yCol = inputTable->colIndex(c->title().text());
int refPoints = d_baseline->dataSize();
double *x = (double *)malloc(refPoints*sizeof(double));
if (!x)
return;
double *y = (double *)malloc(refPoints*sizeof(double));
if (!y){
free (x);
return;
}
for (int i = 0; i < refPoints; i++){
x[i] = d_baseline->x(i);
y[i] = d_baseline->y(i);
}
//sort data with respect to x value
size_t *p = (size_t *)malloc(refPoints*sizeof(size_t));
if (!p){
free(x); free(y);
return;
}
gsl_sort_index(p, x, 1, refPoints);
double *xtemp = (double *)malloc(refPoints*sizeof(double));
if (!xtemp){
free(x); free(y); free(p);
return;
}
double *ytemp = (double *)malloc(refPoints*sizeof(double));
if (!ytemp){
free(x); free(y); free(p); free(xtemp);
return;
}
for (int i = 0; i < refPoints; i++){
xtemp[i] = x[p[i]];
ytemp[i] = y[p[i]];
}
free(x);
free(y);
free(p);
//make linear interpolation on sorted data
gsl_interp_accel *acc = gsl_interp_accel_alloc();
gsl_spline *interp = gsl_spline_alloc(gsl_interp_linear, refPoints);
gsl_spline_init (interp, xtemp, ytemp, refPoints);
for (int i = 0; i < inputPoints; i++){
if (!inputTable->text(i, yCol).isEmpty() && !inputTable->text(i, xCol).isEmpty())
inputTable->setCell(i, yCol, combineValues(inputTable->cell(i, yCol), gsl_spline_eval(interp, inputTable->cell(i, xCol), acc), add));
}
inputTable->notifyChanges(c->title().text());
gsl_spline_free (interp);
gsl_interp_accel_free (acc);
free(xtemp);
free(ytemp);
}
nodo * crop_network(nodo *my_node,int N,edge *my_edge,int Nlinks,long double Nloops_rand,long double Nloops_exp,int contmax)
{
nodo *crop_node;
double *importance,*importance2;
size_t *importance_index;
vector <int> aux;
edge *new_edge;
int Nlinks_eff;
for (int i=0;i<Nlinks;i++) my_edge[i].label=-1;
/* for(int i=0;i<Nlinks;i++) {*/
/* printf("Link[%d] (%d->%d).importance=%d\n",i,my_edge[i].in,my_edge[i].out,my_edge[i].importance);*/
/* }*/
//printf("defino un nuevo vector de links\n");
for(int i=0;i<Nlinks;i++) if (my_edge[i].importance != 0) aux.push_back(i);
new_edge=(edge*)malloc(aux.size()*sizeof(edge));
for(int i=0;i<aux.size();i++) {
new_edge[i].in = my_edge[aux[i]].in;
new_edge[i].out = my_edge[aux[i]].out;
new_edge[i].importance = my_edge[aux[i]].importance;
new_edge[i].label= aux[i];
}
Nlinks_eff=aux.size();
/* for(int i=0;i<Nlinks_eff;i++) {*/
/* printf("new_links[%d] (%d->%d).importance=%d\n",i,new_edge[i].in,new_edge[i].out,new_edge[i].importance);*/
/* }*/
importance=(double*)calloc(Nlinks_eff,sizeof(double));
importance2=(double*)calloc(Nlinks_eff,sizeof(double));
importance_index=(size_t*)malloc(Nlinks_eff*sizeof(size_t));
for (int i=0;i<Nlinks_eff;i++) importance[i]=importance2[i]=new_edge[i].importance*1.;
gsl_sort(importance2,1,Nlinks_eff);
gsl_sort_index(importance_index,importance,1,Nlinks_eff); //ya tenemos ordenados los edges por importancia, y su antiguo nombre esta en index
//printf("primero establecemos los labels en la lista larga!\n");
for (int i=0;i<Nlinks_eff;i++) {
//printf("para el new_link[%d][%d->%d]:\n",i,new_edge[i].in,new_edge[i].out);
int index=0;
for (int j=0;j<new_edge[i].in;j++){
index += my_node[j].kout;
// printf("+M[%d].kout(%d) ",j,my_node[j].kout);
}
// printf("\n");
int nodoi=new_edge[i].in;
for (int j=0;j<my_node[nodoi].kout;j++){
if (new_edge[i].out==my_node[nodoi].out_nodos[j]) break;
index ++;
// printf("+ 1(%d)",my_node[nodoi].out_nodos[j]);
}
// printf("\n");
//printf("en el largo es Links[%d][%d->%d]\n\n",index,my_edge[index].in,my_edge[index].out);
my_edge[index].label=i;
new_edge[i].label2=index;
}
//for (int i=0;i<Nlinks_eff;i++) printf("importance2[%d]=%.0lf label2[%d]=%d i[%d]=%d %d->%d \n",i,importance2[i],i,new_edge[i].label2,i,importance_index[i],new_edge[i].in,new_edge[i].out);//el nodo "inicial(label)" es el nuevo
//for (int i=0;i<Nlinks_eff;i++) printf("importance[%d]=%.0lf i[%d]=%d \n",i,importance[i],i,importance_index[i]);//el nodo "inicial(label)" es el nuevo (label_index)
int cont=Nlinks_eff; printf("Nlinks_eff=%d\n",Nlinks_eff);
//printf("entramos al bucle\n");
resta(Nloops_exp,Nloops_rand,Nlinks_eff,new_edge,importance_index,my_node,N,Nlinks_eff,contmax);
//printf("salimos del bucle\n");
aux.clear();
free(new_edge);
free(importance);
free(importance2);
free(importance_index);
return crop_node;
}
static void rgps_grid2cell(char *line, rgps_grid_t *grid, int nGrids,
rgps_cell_t *cell, int nCells, dbf_header_t *dbf, FILE *fpOut)
{
char **col;
int ii, nCols, nCoords=0, cell_id=0, obs_year;
double obs_time, x_disp, y_disp;
// Extract information from line
split_into_array(line, ',', &nCols, &col);
for (ii=0; ii<nCols; ii++) {
if (dbf[ii].format == CSV_STRING)
dbf[ii].sValue = STRDUP(col[ii]);
else if (dbf[ii].format == CSV_DOUBLE)
dbf[ii].fValue = atof(col[ii]);
else if (dbf[ii].format == CSV_INTEGER)
dbf[ii].nValue = atoi(col[ii]);
if (strcmp_case(dbf[ii].shape, "CELL_ID") == 0)
cell_id = dbf[ii].nValue;
else if (strcmp_case(dbf[ii].shape, "OBS_YEAR") == 0)
obs_year = dbf[ii].nValue;
else if (strcmp_case(dbf[ii].shape, "OBS_TIME") == 0) {
obs_time = dbf[ii].fValue;
if (obs_year > grid[0].obs_year)
obs_time += date_getDaysInYear(grid[0].obs_year);
}
else if (strcmp_case(dbf[ii].shape, "X_DISP") == 0)
x_disp = dbf[ii].fValue;
else if (strcmp_case(dbf[ii].shape, "Y_DISP") == 0)
y_disp = dbf[ii].fValue;
}
free_char_array(&col, nCols);
// Extract information from connectivity table
int *grid_id = (int *) MALLOC(sizeof(int)*50);
double *grid_order = (double *) MALLOC(sizeof(double)*50);
size_t *p = (size_t *) MALLOC(sizeof(size_t)*50);
for (ii=0; ii<nCells; ii++) {
if (cell_id == cell[ii].cell_id) {
grid_id[nCoords] = cell[ii].grid_id;
grid_order[nCoords] = cell[ii].cell_id + (double) cell[ii].order / 100;
nCoords++;
}
}
gsl_sort_index(p, grid_order, 1, nCoords);
double disp_mag = sqrt(x_disp*x_disp + y_disp*y_disp);
// Extract grid information from motion product
int kk, index;
double diff, grid_time, birth_time, death_time;
char image_id[30];
char *tmp = (char *) MALLOC(sizeof(char)*25);
char *coordStr = (char *) MALLOC(sizeof(char)*50*nCoords);
strcpy(coordStr, "");
for (kk=0; kk<nCoords; kk++) {
index = -1;
for (ii=0; ii<nGrids; ii++) {
grid_time = grid[ii].obs_time;
if (grid[ii].obs_year > grid[0].obs_year)
grid_time += date_getDaysInYear(grid[0].obs_year);
diff = fabs(grid_time - obs_time);
if ((grid_id[p[kk]] == grid[ii].gpid) && (diff < 0.01)) {
birth_time = grid[ii].birth_time;
if (grid[ii].birth_year > grid[0].obs_year)
birth_time += date_getDaysInYear(grid[0].obs_year);
index = ii;
}
}
if (index > 0 && birth_time <= grid_time) {
sprintf(tmp, ",%.4f,%.4f", grid[index].x, grid[index].y);
strcat(coordStr, tmp);
strcpy(image_id, grid[index].image_id);
}
}
// Check cell death time
int n, cell_death_year;
double cell_death_time;
split_into_array(line, ',', &n, &col);
for (ii=0; ii<nCells; ii++) {
if (cell[ii].cell_id == atoi(col[0])) {
cell_death_time = death_time = cell[ii].death_time;
cell_death_year = cell[ii].death_year;
if (cell[ii].death_year > cell[0].birth_year)
death_time += date_getDaysInYear(cell[0].birth_year);
if (cell[ii].death_year == -1)
death_time = -1;
}
}
if (death_time < 0 || obs_time < (death_time + 0.01)) {
fprintf(fpOut, "%.6f,%s,%s,%s", obs_time, col[0], col[1], col[2]);
fprintf(fpOut, ",%s,%d,%.6f", col[3], cell_death_year, cell_death_time);
for (kk=4; kk<n; kk++)
fprintf(fpOut, ",%s", col[kk]);
fprintf(fpOut, ",%s,%.6f%s\n", image_id, disp_mag, coordStr);
}
free_char_array(&col, n);
// Clean up
FREE(grid_id);
FREE(grid_order);
FREE(p);
FREE(tmp);
FREE(coordStr);
return;
}
bool Filter::setDataFromTable(Table *t, const QString& xColName, const QString& yColName, int startRow, int endRow)
{
d_init_err = true;
if (!t)
return false;
int xcol = t->colIndex(xColName);
int ycol = t->colIndex(yColName);
if (xcol < 0 || ycol < 0)
return false;
if (t->columnType(xcol) != Table::Numeric || t->columnType(ycol) != Table::Numeric)
return false;
startRow--; endRow--;
if (startRow < 0 || startRow >= t->numRows())
startRow = 0;
if (endRow < 0 || endRow >= t->numRows())
endRow = t->numRows() - 1;
int from = QMIN(startRow, endRow);
int to = QMAX(startRow, endRow);
int r = abs(to - from) + 1;
QVector<double> X(r), Y(r);
int size = 0;
for (int i = from; i<=to; i++ ){
QString xval = t->text(i, xcol);
QString yval = t->text(i, ycol);
if (!xval.isEmpty() && !yval.isEmpty()){
bool valid_data = true;
X[size] = t->locale().toDouble(xval, &valid_data);
Y[size] = t->locale().toDouble(yval, &valid_data);
if (valid_data)
size++;
}
}
if (size < d_min_points){
QMessageBox::critical((ApplicationWindow *)parent(), tr("QtiPlot") + " - " + tr("Error"),
tr("You need at least %1 points in order to perform this operation!").arg(d_min_points));
return false;
}
if (d_n > 0){//delete previousely allocated memory
delete[] d_x;
delete[] d_y;
}
d_graph = 0;
d_curve = 0;
d_n = size;
d_init_err = false;
d_table = t;
d_y_col_name = t->colName(ycol);
X.resize(d_n);
Y.resize(d_n);
d_from = X[0];
d_to = X[d_n-1];
d_x = new double[d_n];
d_y = new double[d_n];
for (int i = 0; i < d_n; i++){
d_x[i] = X[i];
d_y[i] = Y[i];
}
if (d_sort_data){
size_t *p = new size_t[d_n];
gsl_sort_index(p, X.data(), 1, d_n);
for (int i=0; i<d_n; i++){
d_x[i] = X[p[i]];
d_y[i] = Y[p[i]];
}
delete[] p;
}
return true;
}
void generate_kmeans_centres(const double * X,const int dim_x,const int dim_n,const int dim_b,double * centres){
int i,N, iter,k,num_ix,num_empty_clusters;
int* ind_,*empty_clusters,*minDi,*ix;
size_t *sDi;
double * M, * D,*minDv,*X_ix,*X_ix_m,*X_ink,*sDv;
double dist_old, dist_new;
dist_old = 10000;
gsl_permutation *ind;
const gsl_rng_type *T;
gsl_rng * r;
// finish declaration
N = dim_n;
gsl_rng_env_setup();
T = gsl_rng_default;
r = gsl_rng_alloc(T);
gsl_rng_set(r,3);
ind = gsl_permutation_alloc(N);
gsl_permutation_init(ind);
gsl_ran_shuffle(r,ind->data,N,sizeof(size_t));
// gsl_permutation_fprintf(stdout,ind,"%u");
ind_ = malloc(dim_b*sizeof(int));
for (i=0;i<dim_b;i++){
ind_[i] = (int)(gsl_permutation_get(ind,i));
}
M = malloc(dim_x*dim_b*sizeof(double));
D = malloc(dim_b*dim_n*sizeof(double));
minDv = malloc(dim_n*sizeof(double));
minDi = malloc(dim_n*sizeof(int));
sDv = malloc(dim_n*sizeof(double));
sDi = malloc(dim_n*sizeof(int));
ix = malloc(dim_n*sizeof(int));
X_ix_m= malloc(dim_x*1*sizeof(double));
X_ink = malloc(dim_x*sizeof(double));
ccl_get_sub_mat_cols(X,dim_x,dim_n,ind_,dim_b,M);
empty_clusters = malloc(dim_b*sizeof(int));
num_empty_clusters = 0;
for (iter=0;iter<1001;iter++){
num_empty_clusters = 0;
ccl_mat_distance(M,dim_x,dim_b,X,dim_x,dim_n,D);
ccl_mat_min(D,dim_b,dim_n,1,minDv,minDi);
memcpy(sDv,minDv,dim_n*sizeof(double));
memset(empty_clusters,0,dim_b*sizeof(int));
for (k=0;k<dim_b;k++){
memset(ix,0,dim_n*sizeof(int));
num_ix = ccl_find_index_int(minDi,dim_n,1,k,ix);
// print_mat_i(ix,1,dim_n);
X_ix = malloc(dim_x*num_ix*sizeof(double));
if(num_ix!=0){// not empty
ccl_get_sub_mat_cols(X,dim_x,dim_n,ix,num_ix,X_ix);
ccl_mat_mean(X_ix,dim_x,num_ix,0,X_ix_m);
ccl_mat_set_col(M,dim_x,dim_b,k,X_ix_m);
}
else{
empty_clusters[num_empty_clusters] = k;
num_empty_clusters ++;
}
free(X_ix);
}
dist_new = ccl_vec_sum(minDv,dim_n);
if (num_empty_clusters == 0){
if(fabs(dist_old-dist_new)<1E-10) {
memcpy(centres,M,dim_x*dim_b*sizeof(double));
return;
}
}
else{
// print_mat_i(empty_clusters,1,num_empty_clusters);
gsl_sort_index(sDi,sDv,1,dim_n);
gsl_sort(sDv,1,dim_n);
for (k=0;k<num_empty_clusters;k++){
int ii = (int) sDi[dim_n-k-1];
//print_mat_d(X,dim_x,dim_n);
ccl_get_sub_mat_cols(X,dim_x,dim_n,&ii,1,X_ink);
ccl_mat_set_col(M,dim_x,dim_b,empty_clusters[k],X_ink);
}
}
dist_old = dist_new;
}
memcpy(centres,M,dim_x*dim_b*sizeof(double));
gsl_permutation_free(ind);
gsl_rng_free(r);
free(ind_);
free(empty_clusters);
free(minDi);
free(M);
free(minDv);
free(X_ink);
free(ix);
free(sDi);
free(sDv);
free(X_ix_m);
free(D);
}
void gamma_spline_reset (GammaSpline *gs, GList * const sd, int mp, int np, gboolean sort) {
int q=0;
int NB = model->total_bands;
int m,n;
GList * iter = sd;
const int N = g_list_length(iter);
MatrixElement *firstme = (MatrixElement *) iter->data;
size_t ind[NB];
if (sort) {
gsl_sort_index (ind, firstme->energies, 1, NB);
m=ind[mp];
n=ind[np]; // this breaks the 14 band model!
}
else {
m=mp;
n=np;
}
double *en = double_array_calloc(N);
while (iter) {
MatrixElement *me = (MatrixElement *) iter->data;
gs->k[q]=me->kc;
en[q]=(me->energies[n] - me->energies[m])*3e5/1240.7;
gs->Wxr[q]=creal(me->Wx[m+n*NB]);
gs->Wxi[q]=cimag(me->Wx[m+n*NB]);
gs->Wyr[q]=creal(me->Wy[m+n*NB]);
gs->Wyi[q]=cimag(me->Wy[m+n*NB]);
gs->Wzr[q]=creal(me->Wz[m+n*NB]);
gs->Wzi[q]=cimag(me->Wz[m+n*NB]);
iter=g_list_next(iter);
q++;
}
gsl_interp * en_spline;
gsl_interp_accel * en_accel;
en_spline = gsl_interp_alloc(gsl_interp_akima,N);
en_accel = gsl_interp_accel_alloc();
q=gsl_interp_init(en_spline,gs->k,en,N);
gsl_interp_accel_reset (en_accel);
if (m!=n) {
gs->phi[0]=0;
for (q=1;q<N;q++) {
gs->phi[q]=gs->phi[q-1]+2*M_PI*gsl_interp_eval_integ (en_spline, gs->k, en, gs->k[q-1], gs->k[q], en_accel);
}
}
else {
for (q=0;q<N;q++) {
gs->phi[q]=0;
}
}
d_free(en);
gsl_interp_free(en_spline);
gsl_interp_accel_free(en_accel);
q=gsl_interp_init(gs->phi_spline,gs->k,gs->phi,N);
gsl_interp_accel_reset (gs->phi_accel);
q=gsl_interp_init(gs->wx_spline_re,gs->k,gs->Wxr,N);
gsl_interp_accel_reset (gs->w_accel);
q=gsl_interp_init(gs->wx_spline_im,gs->k,gs->Wxi,N);
q=gsl_interp_init(gs->wy_spline_re,gs->k,gs->Wyr,N);
q=gsl_interp_init(gs->wy_spline_im,gs->k,gs->Wyi,N);
q=gsl_interp_init(gs->wz_spline_re,gs->k,gs->Wzr,N);
q=gsl_interp_init(gs->wz_spline_im,gs->k,gs->Wzi,N);
}
int GlmTest::resampNonCase(glm *model, gsl_matrix *bT, unsigned int i) {
unsigned int j, k, id;
double bt, score, yij, mij;
gsl_vector_view yj;
unsigned int nRows = tm->nRows, nVars = tm->nVars;
// to store Rf_unif
// gsl_vector *tmp = gsl_vector_alloc(nRows);
// gsl_permutation *vperm = gsl_permutation_alloc(nRows);
double *tmp = (double *)malloc(nRows * sizeof(double));
// note that residuals have got means subtracted
switch (tm->resamp) {
case RESIBOOT:
for (j = 0; j < nRows; j++) {
if (bootID != NULL)
id = (unsigned int)gsl_matrix_get(bootID, i, j);
else if (tm->reprand == TRUE)
id = (unsigned int)gsl_rng_uniform_int(rnd, nRows);
else
id = (unsigned int)nRows * Rf_runif(0, 1);
// bY = mu+(bootr*sqrt(variance))
for (k = 0; k < nVars; k++) {
bt = gsl_matrix_get(model->Mu, j, k) +
sqrt(gsl_matrix_get(model->Var, j, k)) *
gsl_matrix_get(model->Res, id, k);
bt = MAX(bt, 0.0);
bt = MIN(bt, model->maxtol);
gsl_matrix_set(bT, j, k, bt);
}
}
break;
case SCOREBOOT:
for (j = 0; j < nRows; j++) {
if (bootID != NULL)
score = (double)gsl_matrix_get(bootID, i, j);
else if (tm->reprand == TRUE)
score = gsl_ran_ugaussian(rnd);
else
score = Rf_rnorm(0.0, 1.0);
// bY = mu + score*sqrt(variance)
for (k = 0; k < nVars; k++) {
bt = gsl_matrix_get(model->Mu, j, k) +
sqrt(gsl_matrix_get(model->Var, j, k)) *
gsl_matrix_get(model->Res, j, k) * score;
bt = MAX(bt, 0.0);
bt = MIN(bt, model->maxtol);
gsl_matrix_set(bT, j, k, bt);
}
}
break;
case PERMUTE:
if (bootID == NULL) {
if (tm->reprand == TRUE)
gsl_ran_shuffle(rnd, permid, nRows, sizeof(size_t));
else { // Permutation with the randomness set in R
for (j = 0; j < nRows; j++)
tmp[j] = Rf_runif(0, 1);
gsl_sort_index(permid, tmp, 1, nRows);
}
}
for (j = 0; j < nRows; j++) {
if (bootID == NULL)
id = permid[j];
else
id = (unsigned int)gsl_matrix_get(bootID, i, j);
// bY = mu + bootr * sqrt(var)
for (k = 0; k < nVars; k++) {
bt = gsl_matrix_get(model->Mu, j, k) +
sqrt(gsl_matrix_get(model->Var, j, k)) *
gsl_matrix_get(model->Res, id, k);
bt = MAX(bt, 0.0);
bt = MIN(bt, model->maxtol);
gsl_matrix_set(bT, j, k, bt);
}
}
break;
case FREEPERM:
if (bootID == NULL) {
if (tm->reprand == TRUE)
gsl_ran_shuffle(rnd, permid, nRows, sizeof(size_t));
else { // Permutation with the randomness set in R
for (j = 0; j < nRows; j++)
tmp[j] = Rf_runif(0, 1);
gsl_sort_index(permid, tmp, 1, nRows);
}
}
for (j = 0; j < nRows; j++) {
if (bootID == NULL)
id = permid[j];
else
id = (unsigned int)gsl_matrix_get(bootID, i, j);
yj = gsl_matrix_row(model->Yref, id);
gsl_matrix_set_row(bT, j, &yj.vector);
}
break;
case MONTECARLO:
McSample(model, rnd, XBeta, Sigma, bT);
break;
case PITSBOOT:
for (j = 0; j < nRows; j++) {
if (bootID != NULL)
id = (unsigned int)gsl_matrix_get(bootID, i, j);
else if (tm->reprand == TRUE)
id = (unsigned int)gsl_rng_uniform_int(rnd, nRows);
else
id = (unsigned int)Rf_runif(0, nRows);
for (k = 0; k < nVars; k++) {
bt = gsl_matrix_get(model->PitRes, id, k);
mij = gsl_matrix_get(model->Mu, j, k);
yij = model->cdfinv(bt, mij, model->theta[k]);
gsl_matrix_set(bT, j, k, yij);
}
}
break;
default:
GSL_ERROR("The resampling method is not supported", GSL_ERANGE);
break;
}
free(tmp);
return SUCCESS;
}
dfsp_table*create_dfsp_lookuptable(urdme_model *model, const double tauD, const double error_tolerance, const int max_jump_in,
const int report_level){
//----------------------------------------
int Ndofs = model->Ncells*model->Mspecies;
dfsp_table*table = (dfsp_table*)malloc(sizeof(dfsp_table)); //the return element
//----------------------------------------
int max_jump = max_jump_in;
if(max_jump<0){ max_jump=3; } // set default
//----------------------------------------
int last_percent_reported=0;
//----------------------------------------
clock_t start_timer,end_timer;
double elapsed_time;
int i,j,k,m;
//----------------------------------------
if(report_level>0){ printf("Starting State-Space Exploration (uniformization): tau=%e tol=%e max=%i\n",tauD,error_tolerance,max_jump); }
start_timer=clock();
/* To hold the output */
size_t *jcD_out,*irD_out;
double *prD_out;
/* Uniformization parameters. */
/*
* MAX_ITER affects the chosen timestep by the solver,
* since we modify the timestep such that uniformization converges
* in at most this number of iterations
*/
int MAX_ITER = 50;
double lambda_max;
double poisspdf[MAX_ITER],totp=0.0,normp,max_error=0.0,rhs;
size_t ix;
jcD_out = (size_t *)malloc((Ndofs+1)*sizeof(size_t));
jcD_out[0] = 0;
/* To hold the current pvd */
double *pdvi,*temp1,*temp2;
pdvi = (double *)malloc(Ndofs*sizeof(double));
temp1 = (double *)malloc(Ndofs*sizeof(double));
temp2 = (double *)malloc(Ndofs*sizeof(double));
/* Compute lambda_max */
lambda_max = 0.0;
for (i=0;i<Ndofs;i++){
for (j=model->jcD[i];j<model->jcD[i+1];j++){
if (model->irD[j]==i)
if (-model->prD[j]>lambda_max)
lambda_max = -model->prD[j];
}
}
if (report_level>1){
printf("lambda_max %.4e\n",lambda_max);
}
/*
We get a proposed timestep passed to the function (from error estimation).
If this is too large for uniformization to converge in MAX_ITER iterations,
we reduce the timestep.
*/
double dt = tauD;
totp = 1.0;
do {
totp=1.0;
for (i=0; i<MAX_ITER; i++) {
totp-=gsl_ran_poisson_pdf(i,lambda_max*dt);
}
if(totp>error_tolerance/2.0){
dt/=2.0;
}
}while (totp>error_tolerance/2.0);
if (dt<tauD){
if (report_level>1){
printf("Uniformization: overriding suggested tauD. Using tau_d = %e\n",dt);
}
}
int start,stop;
size_t nnz_coli=0;
size_t nnz_coli_T=0;
double cumsum;
size_t *index;
index = (size_t *)malloc(Ndofs*sizeof(size_t));
/* Create the uniformized matrix. If memory is an issue, it is not necessary to
form A expplicitly, but the code will run faster with A. */
size_t *jcA,*irA;
double *prA;
int nnztot = model->jcD[Ndofs];
jcA = (size_t *)malloc((Ndofs+1)*sizeof(size_t));
irA = (size_t *)malloc(nnztot*sizeof(size_t));
prA = (double *)malloc(nnztot*sizeof(double));
memcpy(jcA,model->jcD,(Ndofs+1)*sizeof(size_t));
memcpy(irA,model->irD,nnztot*sizeof(size_t));
memcpy(prA,model->prD,nnztot*sizeof(double));
/* Rescaled matrix. Obs. we do not add the eye-matrix here, since this may
* cause error in the case of an all zero column. Instead we do that in
* the main matrix-vector multiply loop */
for (i=0;i<Ndofs;i++){
for (j=jcA[i];j<jcA[i+1];j++){
prA[j]=prA[j]/lambda_max;
}
}
/* Compute the Poisson PDF and determine how many iterations we need to do in the main loop. */
int NUM_ITER=MAX_ITER;
totp = 1.0;
for (k=0;k<MAX_ITER;k++){
poisspdf[k] = gsl_ran_poisson_pdf(k,lambda_max*dt);
totp-=poisspdf[k];
if (totp <= error_tolerance/2.0){
NUM_ITER = k+1;
break;
}
}
for(i=0;i<Ndofs;i++){
/* report every 5% */
if(report_level>1){
int cur_percent = (int) floor(((double)i/(double)Ndofs)*100.0);
if(cur_percent > last_percent_reported + 4){
last_percent_reported = cur_percent;
end_timer=clock();
elapsed_time = (double)(end_timer-start_timer)/CLOCKS_PER_SEC;
printf("%i%% complete\t\telapsed: %es\n",last_percent_reported,elapsed_time);
}
}
/* Initial condition */
memset(pdvi,0.0,Ndofs*sizeof(double));
memset(temp1,0.0,Ndofs*sizeof(double));
memset(temp2,0.0,Ndofs*sizeof(double));
temp1[i]=1.0;
double *val,*valend;
size_t *ind;
totp=1.0;
for(k=0; k<NUM_ITER; k++){
/* Add to pdvi */
cblas_daxpy(Ndofs,poisspdf[k],temp1,1,pdvi,1);
/* Sparse matrix-dense vector product. */
for (m=0;m<Ndofs;m++){
rhs = temp1[m];
if (rhs > 0.0){ // > works since we know that temp1 will always be positive.
start = jcA[m];
stop = jcA[m+1];
ix = (stop-start) % 4;
for (j=start; j<start+ix; j++) {
temp2[irA[j]] += rhs*prA[j];
}
for (j=start+ix; j+3<stop; j += 4) {
temp2[irA[j]] += rhs*prA[j];
temp2[irA[j+1]] += rhs*prA[j+1];
temp2[irA[j+2]] += rhs*prA[j+2];
temp2[irA[j+3]] += rhs*prA[j+3];
}
/* Add unit diagonal */
temp2[m] += 1.0*rhs;
}
}
memcpy(temp1,temp2,Ndofs*sizeof(double));
memset(temp2,0.0,Ndofs*sizeof(double));
}
/* Sort pdvi in decending order */
memset(index,0,Ndofs*sizeof(size_t));
gsl_sort_index(index,pdvi,1,(size_t)Ndofs);
#if 0 //OLD WAY
/* Count the number of non-zeros in this column (PDV) */
cumsum = 0.0; j=Ndofs-1; nnz_coli=0;
for (j=Ndofs-1; j>=0; j--){
cumsum+=pdvi[index[j]];
if (pdvi[index[j]]==0.0)
break;
nnz_coli++;
}
#else //CORRECT WAY
/* Count the number of non-zeros in this column (PDV) */
int min_col_sz = model->jcD[i+1]-model->jcD[i]; //size of the column of the D matrix
cumsum = 0.0; j=Ndofs-1; nnz_coli=0;
for (j=Ndofs-1; j>=0; j--){
cumsum+=pdvi[index[j]];
if (pdvi[index[j]]==0.0)
break;
nnz_coli++;
if(nnz_coli>=min_col_sz && 1.0-cumsum < error_tolerance){
break;
}
}
#endif
nnz_coli_T+=nnz_coli;
/* Assemble into the lookup-table (sparse matrix) */
jcD_out[i+1]=jcD_out[i]+(size_t)nnz_coli; //record the begining of this colum
if(i==0){
irD_out = (size_t*) malloc(nnz_coli*sizeof(size_t));
}else{
irD_out = (size_t*) realloc(irD_out,jcD_out[i+1]*sizeof(size_t));
}
if(i==0){
prD_out = (double*) malloc(nnz_coli*sizeof(double));
}else{
prD_out = (double*) realloc(prD_out,jcD_out[i+1]*sizeof(double));
}
/* For optimization purposes, we store the CDF rather than the PDF
here, since all we are going to do with this matrix is
inverse transform sampling during the DFSP step. */
start = (int)jcD_out[i]; k=0; cumsum = 0.0;
for (k=0;k<nnz_coli;k++){
irD_out[start+k] = index[Ndofs-k-1];
cumsum += pdvi[index[Ndofs-k-1]];
prD_out[start+k] = cumsum;
}
/**
* Renormalize, so that the PDF sums to 1.0
* We spread the epsilon error equal on all the remaining states.
* This is why we needed to compute to tol/2 accuracy.
*/
for (k=0; k<nnz_coli; k++) {
prD_out[start+k]/=cumsum;
}
}
end_timer=clock();
elapsed_time = (double)(end_timer-start_timer)/CLOCKS_PER_SEC;
/* Stats */
/* Average serch depth */
/*double sdepth=0.0;
for (i=0;i<Ndofs;i++){
k=0;
start = jcD_out[i];
stop = jcD_out[i+1];
for (j=start; j<stop;j++){
if(prD_out[j]>0.5)
break;
k++;
}
if (k>sdepth)
sdepth = k;
}*/
int nnzi;
int maxnnzi = 0;
for (i=0;i<Ndofs;i++){
nnzi = jcD_out[i+1]-jcD_out[i];
if (nnzi>maxnnzi)
maxnnzi = nnzi;
}
if(report_level>0){ printf("\tComplete: elapsed: %es, error=%e Nmax=%i\n",elapsed_time,error_tolerance,maxnnzi);}
if(report_level>1){printf("Number of iterations: %i\n",NUM_ITER); }
// printf("Max search depth: %f\n",sdepth);
//----------------------------------------
table->Ndofs = Ndofs;
table->error_tolerance = max_error;
table->tau_d = dt;
table->max_jump = max_jump;
table->jcD = jcD_out;
table->irD = irD_out;
table->prD = prD_out;
#ifdef DFSP_PROFILER
profiler_addmemory("Lookup tables",(Ndofs+1)*sizeof(size_t) + jcD_out[Ndofs]*(sizeof(size_t)+sizeof(double)));
#endif
//----------------------------------------
free(index);
free(pdvi);
free(temp1);
free(temp2);
free(jcA);
free(irA);
free(prA);
//----------------------------------------
return table;
}
/*
* Given an input double precision array, Haar wavelet transform is
* applied to convert it to a set of wavelet coefficients. The quantization is
* done by making [n - ncoefficients] lowest absolute value coefficients 0.
* The resulting coefficients and the position of those coefficients are saved
* within the compressed buffer.
* [double precision version of compress_wavelets_float]
*/
void compress_wavelets_double (const double *original_buffer,
uint32_t num_elements,
uint32_t num_coefficients,
uchar *compressed_buffer,
uint32_t *compressed_buffer_size
)
{
// If the total number of elements is less than the number of coefficients
// try to reduce the number of coefficients used. This should happen only
// for the last linearized window
if (num_elements == 1) {
num_coefficients = 1;
} else if (num_elements <= num_coefficients) {
num_coefficients = num_elements / 2;
}
// Number of bits to use per index element for marking the position of the
// saved coefficients.
uint32_t bits_per_index_element = calculate_bits_needed (num_elements - 1);
uint32_t num_total_elements = 0;
if ((num_elements & (num_elements - 1)) == 0) {
num_total_elements = num_elements;
} else {
bits_per_index_element ++;
num_total_elements = (1 << bits_per_index_element);
}
// If the total number of elements is not a multiple of 2^(WAVELET_NLEVEL),
// then pad values to the array. The padded value is the maximum value in
// the array.
uint32_t num_pad_elements = num_total_elements - num_elements;
double *wavelet_transform_buffer = (double *) malloc (num_total_elements * sizeof (double));
double *absolute_coefficients = (double *) malloc (num_total_elements * sizeof (double));
uint32_t i = 0;
uchar *compressed_buffer_start = compressed_buffer;
size_t *index = (size_t *) malloc (num_total_elements * sizeof (size_t));
assert (wavelet_transform_buffer != 0);
assert (absolute_coefficients != 0);
assert (index != 0);
memcpy (wavelet_transform_buffer, original_buffer, num_total_elements * sizeof (double));
// Pad with the maximum value
for (i = 0; i < num_pad_elements; i ++) {
wavelet_transform_buffer [i + num_elements] = wavelet_transform_buffer [num_elements - 1];
}
// Perform transformation using HAAR wavelets
haar_wavelet_transform_forward_double (wavelet_transform_buffer, num_total_elements);
// Original buffer has been replaced with wavelet coefficients.
// Get the coefficients whose absolute value is minimal.
for (i = 0; i < num_total_elements; i++) {
absolute_coefficients [i] = fabs (wavelet_transform_buffer [i]);
}
gsl_sort_index (index, absolute_coefficients, 1, num_total_elements);
SET (uint32_t, compressed_buffer, num_total_elements)
compressed_buffer += sizeof (uint32_t);
SET (uint32_t, compressed_buffer, num_coefficients)
compressed_buffer += sizeof (uint32_t);
// Save the top n coefficients
uint32_t top = 0;
uint32_t *coefficients_position = (uint32_t *) malloc (sizeof (uint32_t) * num_coefficients);
uint32_t packed_coefficients_position_size = 0;
for (i = num_total_elements - num_coefficients; i < num_total_elements; i ++) {
((double *) compressed_buffer) [top] = wavelet_transform_buffer [index [i]];
coefficients_position [top] = index [i];
top ++;
}
// Store the locations of top n coefficients in bit-packed form
compressed_buffer += num_coefficients * sizeof (double);
write_to_bitstream (num_coefficients, bits_per_index_element, coefficients_position, (uint32_t *) (compressed_buffer + sizeof (uint32_t)), &packed_coefficients_position_size);
SET (uint32_t, compressed_buffer, packed_coefficients_position_size);
compressed_buffer += sizeof (uint32_t);
compressed_buffer += sizeof (uint32_t) * packed_coefficients_position_size;
*compressed_buffer_size = (compressed_buffer - compressed_buffer_start);
// Clear buffers
free (coefficients_position);
free (absolute_coefficients);
free (index);
free (wavelet_transform_buffer);
return ;
}
int rgb_permutations(Test **test,int irun)
{
uint i,j,k,permindex=0,t;
Vtest vtest;
double *testv;
size_t ps[4096];
gsl_permutation** lookup;
MYDEBUG(D_RGB_PERMUTATIONS){
printf("#==================================================================\n");
printf("# rgb_permutations: Debug with %u\n",D_RGB_PERMUTATIONS);
}
/*
* Number of permutations. Note that the minimum ntuple value for a
* valid test is 2. If ntuple is less than 2, we choose the default
* test size as 5 (like operm5).
*/
if(ntuple<2){
test[0]->ntuple = 5;
} else {
test[0]->ntuple = ntuple;
}
k = test[0]->ntuple;
nperms = gsl_sf_fact(k);
/*
* A vector to accumulate rands in some sort order
*/
testv = (double *)malloc(k*sizeof(double));
MYDEBUG(D_RGB_PERMUTATIONS){
printf("# rgb_permutations: There are %u permutations of length k = %u\n",nperms,k);
}
/*
* Create a test, initialize it.
*/
Vtest_create(&vtest,nperms);
vtest.cutoff = 5.0;
for(i=0;i<nperms;i++){
vtest.x[i] = 0.0;
vtest.y[i] = (double) test[0]->tsamples/nperms;
}
MYDEBUG(D_RGB_PERMUTATIONS){
printf("# rgb_permutations: Allocating permutation lookup table.\n");
}
lookup = (gsl_permutation**) malloc(nperms*sizeof(gsl_permutation*));
for(i=0;i<nperms;i++){
lookup[i] = gsl_permutation_alloc(k);
}
for(i=0;i<nperms;i++){
if(i == 0){
gsl_permutation_init(lookup[i]);
} else {
gsl_permutation_memcpy(lookup[i],lookup[i-1]);
gsl_permutation_next(lookup[i]);
}
}
MYDEBUG(D_RGB_PERMUTATIONS){
for(i=0;i<nperms;i++){
printf("# rgb_permutations: %u => ",i);
gsl_permutation_fprintf(stdout,lookup[i]," %u");
printf("\n");
}
}
/*
* We count the order permutations in a long string of samples of
* rgb_permutation_k non-overlapping rands. This is done by:
* a) Filling testv[] with rgb_permutation_k rands.
* b) Using gsl_sort_index to generate the permutation index.
* c) Incrementing a counter for that index (a-c done tsamples times)
* d) Doing a straight chisq on the counter vector with nperms-1 DOF
*
* This test should be done with tsamples > 30*nperms, easily met for
* reasonable rgb_permutation_k
*/
for(t=0;t<test[0]->tsamples;t++){
/*
* To sort into a perm, test vector needs to be double.
*/
for(i=0;i<k;i++) {
testv[i] = (double) gsl_rng_get(rng);
MYDEBUG(D_RGB_PERMUTATIONS){
printf("# rgb_permutations: testv[%u] = %u\n",i,(uint) testv[i]);
}
}
gsl_sort_index(ps,testv,1,k);
MYDEBUG(D_RGB_PERMUTATIONS){
for(i=0;i<k;i++) {
printf("# rgb_permutations: ps[%u] = %lu\n",i,ps[i]);
}
}
for(i=0;i<nperms;i++){
if(memcmp(ps,lookup[i]->data,k*sizeof(size_t))==0){
permindex = i;
MYDEBUG(D_RGB_PERMUTATIONS){
printf("# Found permutation: ");
gsl_permutation_fprintf(stdout,lookup[i]," %u");
printf(" = %u\n",i);
}
break;
}
}
vtest.x[permindex]++;
MYDEBUG(D_RGB_PERMUTATIONS){
printf("# rgb_permutations: Augmenting vtest.x[%u] = %f\n",permindex,vtest.x[permindex]);
}
}