/* unconditional discrete sampling. */
void rbn_discrete_root(SEXP result, int cur, SEXP cpt, int *num, int ordinal,
SEXP fixed) {
int np = LENGTH(cpt), *gen = NULL, *workplace = NULL;
double *p = NULL;
SEXP generated, class, lvls;
/* get the levels of the curent variable .*/
lvls = VECTOR_ELT(getAttrib(cpt, R_DimNamesSymbol), 0);
/* allocate the memory for the generated observations. */
PROTECT(generated = allocVector(INTSXP, *num));
gen = INTEGER(generated);
if (fixed != R_NilValue) {
int constant = INTEGER(match(lvls, fixed, 0))[0];
for (int i = 0; i < *num; i++)
gen[i] = constant;
}/*THEN*/
else {
workplace = alloc1dcont(np);
/* duplicate the probability table to save the original copy from tampering. */
p = alloc1dreal(np);
memcpy(p, REAL(cpt), np * sizeof(double));
/* perform the random sampling. */
ProbSampleReplace(np, p, workplace, *num, gen);
}/*ELSE*/
/* set up all the attributes for the newly generated observations. */
setAttrib(generated, R_LevelsSymbol, lvls);
if (ordinal) {
PROTECT(class = allocVector(STRSXP, 2));
SET_STRING_ELT(class, 0, mkChar("ordered"));
SET_STRING_ELT(class, 1, mkChar("factor"));
}/*THEN*/
else {
// modificato il prototipo per aumentare l'efficienza
VETTOREi *sample1(VETTOREi *ris, int n, int k, int replace, double *p)
{
int *x;
int i, nc = 0;
GetRNGstate();
CREAv_i(ris, k);
// g_x mi serve comunque (e sempre di dim. n)
// OTTIMIZZATA da me!
CREAv_i(g_x, n); // cosi` non ho problemi nel caso sia troppo piccolo
x = g_x->dati;
if (p != NULL) {
FixupProb(p, n, k, replace);
if (replace) {
for (i = 0; i < n; i++) {
if (n * p[i] > 0.1)
nc++;
}
if (nc > 200)
walker_ProbSampleReplace(n, p, x, k, ris->dati);
else
ProbSampleReplace(n, p, x, k, ris->dati);
}
else
ProbSampleNoReplace(n, p, x, k, ris->dati);
}
else {
/* avoid allocation for a single sample */
if (replace || k < 2)
SampleReplace(k, n, ris->dati);
else { // ho gia` allocato g_x
SampleNoReplace(k, n, ris->dati, x);
}
}
PutRNGstate();
return ris;
}
