/* 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; }