RcppExport SEXP reloadPars(SEXP Rlongpars, SEXP Rpars, SEXP Rngroups, SEXP RJ)
{
BEGIN_RCPP
const NumericVector longpars(Rlongpars);
List pars(Rpars);
const int ngroups = as<int>(Rngroups);
const int J = as<int>(RJ);
int ind = 0;
for(int g = 0; g < ngroups; ++g){
List glist = pars[g];
for(int i = 0; i < (J+1); ++i){
S4 item = glist[i];
NumericVector p = item.slot("par");
int len = p.length();
for(int j = 0; j < len; ++j)
p(j) = longpars(ind+j);
ind += len;
item.slot("par") = p;
glist[i] = item;
}
pars[g] = glist;
}
return(pars);
END_RCPP
}
// [[Rcpp::export]]
void doubleBM(const S4& BM, XPtr<BigMatrix> xpMat2) {
XPtr<BigMatrix> xpMat = BM.slot("address");
int n = xpMat->nrow();
int m = xpMat->ncol();
RawSubMatAcc macc(*xpMat, seq_len(n)-1, seq_len(m)-1, BM.slot("code"));
MatrixAccessor<unsigned char> macc2(*xpMat2);
int i, j, j2;
double tmp;
for (j = j2 = 0; j < m; j++, j2 += 2) {
for (i = 0; i < n; i++) {
tmp = macc(i, j);
if (tmp == 0) {
macc2[j2][i] = macc2[j2+1][i] = 0;
} else if (tmp == 1) {
macc2[j2][i] = 0;
macc2[j2+1][i] = 1;
} else if (tmp == 2) {
macc2[j2][i] = macc2[j2+1][i] = 1;
} else {
throw Rcpp::exception("Your big.matrix should have only Os, 1s or 2s");
}
}
}
}
// [[Rcpp::export]]
S4 CPP_scale_margins_sparse(S4 M, NumericVector rows, NumericVector cols, bool duplicate = true) {
if (!M.is("dgCMatrix"))
stop("internal error -- not a canonical sparse matrix");
IntegerVector dims = M.slot("Dim");
int nr = dims[0], nc = dims[1];
if (nr != rows.size() || nc != cols.size())
stop("internal error -- row/column weights not conformable with matrix");
if (duplicate)
M = clone(M);
IntegerVector p = M.slot("p");
IntegerVector::iterator _p = p.begin();
IntegerVector row_of = M.slot("i");
IntegerVector::iterator _row_of = row_of.begin();
NumericVector x = M.slot("x");
NumericVector::iterator _x = x.begin();
NumericVector::iterator _rows = rows.begin();
for (int col = 0; col < nc; col++) {
double col_weight = cols[col];
for (int i = _p[col]; i < _p[col+1]; i++) {
_x[i] *= _rows[_row_of[i]] * col_weight;
}
}
return M;
}
RcppExport SEXP computeItemTrace(SEXP Rpars, SEXP RTheta, SEXP Ritemloc, SEXP Roffterm)
{
BEGIN_RCPP
const List pars(Rpars);
const NumericMatrix Theta(RTheta);
const NumericMatrix offterm(Roffterm);
const vector<int> itemloc = as< vector<int> >(Ritemloc);
const int J = itemloc.size() - 1;
const int nfact = Theta.ncol();
const int N = Theta.nrow();
vector<double> itemtrace(N * (itemloc[J]-1));
S4 item = pars[0];
NumericMatrix FD = item.slot("fixed.design");
int USEFIXED = 0;
if(FD.nrow() > 2) USEFIXED = 1;
for(int which = 0; which < J; ++which)
_computeItemTrace(itemtrace, Theta, pars, offterm(_, which), itemloc,
which, nfact, N, USEFIXED);
NumericMatrix ret = vec2mat(itemtrace, N, itemloc[J]-1);
return(ret);
END_RCPP
}
// [[Rcpp::export]]
List ctmcFit(List data, bool byrow=true, String name="", double confidencelevel = 0.95)
{
CharacterVector stateData(as<CharacterVector>(data[0]).size());
for(int i = 0; i < as<CharacterVector>(data[0]).size(); i++)
stateData[i] = as<CharacterVector>(data[0])[i];
NumericVector transData = data[1];
CharacterVector sortedStates = unique(as<CharacterVector>(data[0])).sort();
NumericVector stateCount(sortedStates.size());
NumericVector stateSojournTime(sortedStates.size());
List dtmcData = markovchainFit(stateData, "mle", byrow, 10, 0, name, false, confidencelevel);
for(int i = 0; i < stateData.size() - 1; i++){
int idx = std::find(sortedStates.begin(), sortedStates.end(), stateData[i]) - sortedStates.begin();
stateCount[idx]++;
stateSojournTime[idx] += transData[i+1] - transData[i];
}
S4 dtmcEst = dtmcData["estimate"];
NumericMatrix gen = dtmcEst.slot("transitionMatrix");
for(int i = 0; i < gen.nrow(); i++){
for(int j = 0; j < gen.ncol(); j++){
if(stateCount[i] > 0)
gen(i, j) *= stateCount[i] / stateSojournTime[i];
}
if(stateCount[i] > 0)
gen(i, i) = - stateCount[i] / stateSojournTime[i];
else
gen(i, i) = -1;
}
double zscore = stats::qnorm_0(confidencelevel, 1.0, 0.0);
NumericVector lowerConfVecLambda(sortedStates.size()), upperConfVecLambda(sortedStates.size());
for(int i = 0; i < sortedStates.size(); i++){
if(stateCount[i] > 0){
lowerConfVecLambda(i) = std::max(0., stateCount[i] / stateSojournTime[i] * (1 - zscore / sqrt(stateCount[i])));
upperConfVecLambda(i) = std::min(1., stateCount[i] / stateSojournTime[i] * (1 + zscore / sqrt(stateCount[i])));
}
else{
lowerConfVecLambda(i) = 1;
upperConfVecLambda(i) = 1;
}
}
S4 outCtmc("ctmc");
outCtmc.slot("states") = sortedStates;
outCtmc.slot("generator") = gen;
outCtmc.slot("name") = name;
return List::create(_["estimate"] = outCtmc,
_["errors"] = List::create(_["dtmcConfidenceInterval"] = dtmcData["confidenceInterval"],
_["lambdaConfidenceInterval"] = List::create(_["lowerEndpointVector"] = lowerConfVecLambda,
_["upperEndpointVector"] = upperConfVecLambda)));
}
//' @title
//' Augment censored data using a Gibbs step
//' @description
//' Augment censored data by drawing them from a truncated normal
//'
//' @param DP is an S4 object of type DP, HDP, or NDP.
//' @param DataStore is an S4 object of the same name.
//' @param xi is an integer vector that describes to which cluster belong an observation
//' @param zeta is an integer vector that describes in which cluster belong a group of observations
//' @export
// [[Rcpp::export]]
S4 gibbsStep(S4 DP, S4 DataStorage, IntegerVector xi, IntegerVector zeta){
NumericVector RealData = DataStorage.slot("computation");
IntegerVector censoring = DataStorage.slot("censoring");
const int N = RealData.length();
NumericMatrix Theta = DP.slot("theta");
NumericMatrix Phi = DP.slot("phi");
NumericVector toRetData(N, NumericVector::get_na());
int temp;
for(int n=0; n < N; n++){
// if n is not NA
if(RealData(n) == RealData(n)){
temp = xi[n];
const int l = temp - 1;
temp = zeta[n];
const int k = temp - 1;
toRetData(n) = censoring(n) ? RealData(n) : rtruncnorm(RealData(n), Theta(l,k), std::sqrt(Phi(l,k)));
}
}
DataStorage.slot("simulation") = toRetData;
return DataStorage;
}
SEXP hashed_model_matrix(RObject tf, DataFrameLike data, unsigned long hash_size, bool transpose, S4 retval, bool keep_hashing_mapping, bool is_xi, bool progress) {
if (hash_size > 4294967296) throw std::invalid_argument("hash_size is too big!");
NameClassMapping reference_class(get_class(data));
Environment e(Environment::base_env().new_child(wrap(true)));
std::shared_ptr<HashFunction> pHF(NULL), pBHF(NULL);
if (keep_hashing_mapping) {
pHF.reset(new MurmurHash3LogHashFunction(wrap(e), MURMURHASH3_H_SEED));
} else {
pHF.reset(new MurmurHash3HashFunction(MURMURHASH3_H_SEED));
}
if (is_xi) pBHF.reset(new MurmurHash3HashFunction(MURMURHASH3_XI_SEED));
else pBHF.reset(new NullHashFunction);
ConvertersVec converters(get_converters(reference_class, tf, data, pHF.get(), pBHF.get(), hash_size));
#ifdef NOISY_DEBUG
Rprintf("The size of convertres is %d\n", converters.size());
#endif
std::vector<int> ivec, pvec(1, 0);
std::vector<double> xvec;
bool is_intercept = as<bool>(tf.attr("intercept"));
#ifdef NOISY_DEBUG
Rprintf("nrow(data): %d length(converters): %d\n", data.nrows(), converters.size());
#endif
std::shared_ptr<boost::progress_display> pd(NULL);
if (transpose) {
if (progress) pd.reset(new boost::progress_display(data.nrows(), Rcpp::Rcout));
for(auto i = 0;i < data.nrows();i++) {
if (progress) ++(*pd);
if (is_intercept) {
ivec.push_back(0);
xvec.push_back(1.0);
}
for(auto j = converters.begin();j != converters.end();j++) {
pVectorConverter& p(*j);
const std::vector<uint32_t>& i_origin(p->get_feature(i));
const std::vector<double>& x_origin(p->get_value(i));
#ifdef NOISY_DEBUG
std::for_each(i_origin.begin(), i_origin.end(), [&hash_size](uint32_t hashed_value) {
Rprintf("(%zu module %d = %d),", hashed_value, hash_size, hashed_value % hash_size);
});
Rprintf("\n");
#endif
std::for_each(i_origin.begin(), i_origin.end(), [&ivec, &xvec, &hash_size](uint32_t hashed_value) {
ivec.push_back(hashed_value);
});
xvec.insert(xvec.end(), x_origin.begin(), x_origin.end());
}
pvec.push_back(ivec.size());
}
}
else {
if (progress) pd.reset(new boost::progress_display(data.nrows(), Rcpp::Rcout));
std::map< uint32_t, std::pair< std::vector<int>, std::vector<double> > > cache;
if (is_intercept) {
std::pair< std::vector<int>, std::vector<double> >& k(cache[0]);
k.first.resize(data.nrows());
for(int i = 0;i < data.nrows();i++) {
k.first[i] = i;
}
k.second.resize(data.nrows(), 1.0);
}
for(auto i = 0;i < data.nrows();i++) {
if (progress) ++(*pd);
for(auto j = converters.begin();j != converters.end();j++) {
pVectorConverter& p(*j);
const std::vector<uint32_t>& i_origin(p->get_feature(i));
const std::vector<double>& x_origin(p->get_value(i));
auto x_value = x_origin.begin();
std::for_each(i_origin.begin(), i_origin.end(), [&cache, &hash_size, &x_value, &i](uint32_t hashed_value) {
std::pair< std::vector<int>, std::vector<double> >& k(cache[hashed_value]);
k.first.push_back(i);
k.second.push_back(*(x_value++));
});
}
}
int pvec_value = ivec.size();
for(auto i = cache.begin();i != cache.end();i++) {
while(pvec.size() <= i->first) pvec.push_back(pvec_value);
ivec.insert(ivec.end(), i->second.first.begin(), i->second.first.end());
{
std::vector<int> tmp;
i->second.first.swap(tmp);
}
xvec.insert(xvec.end(), i->second.second.begin(), i->second.second.end());
{
std::vector<double> tmp;
i->second.second.swap(tmp);
}
pvec_value = ivec.size();
}
pvec.resize(hash_size + 1, pvec_value);
}
retval.slot("i") = wrap(ivec);
retval.slot("p") = wrap(pvec);
retval.slot("x") = wrap(xvec);
IntegerVector dim(2);
if (transpose) {
dim[0] = hash_size;
dim[1] = pvec.size() - 1;
retval.slot("Dim") = dim;
}
else {
dim[0] = data.nrows();
dim[1] = hash_size;
retval.slot("Dim") = dim;
}
{
List dimnames(2);
dimnames[0] = CharacterVector(0);
dimnames[1] = CharacterVector(0);
retval.slot("Dimnames") = dimnames;
}
retval.slot("factors") = List();
{
CharacterVector key(e.ls(true));
std::for_each(key.begin(), key.end(), [&e, &hash_size](const char* s) {
uint32_t *p = (uint32_t*) INTEGER(e[s]);
p[0] = p[0] % hash_size;
});
}
retval.attr("mapping") = e;
return retval;
}
////> Main function ////
// [[Rcpp::export]]
List calcPotts_cpp (const S4& W_SR, const S4& W_LR, arma::mat sample, NumericVector rho, const arma::mat& coords,
const IntegerVector& site_order, int iter_max, double cv_criterion,
bool test_regional, NumericVector distance_ref, double threshold, double neutre, int nbGroup_min, bool multiV, bool last_vs_others,
bool prior, bool type_reg, int verbose){
//// preparation
int p = sample.n_cols;
int n = sample.n_rows;
IntegerVector W_SRi = W_SR.slot("i");
IntegerVector W_SRp = W_SR.slot("p");
NumericVector W_SRx = W_SR.slot("x");
arma::mat Wpred(n, p);
vector < vector < double > > pred_global(p);
for(int iter_p = 0 ; iter_p < p ; iter_p ++){
pred_global[iter_p].resize(n);
for(int iter_px = 0 ; iter_px < n ; iter_px++){
pred_global[iter_p][iter_px] = sample(iter_px, iter_p);
}
}
vector < vector < double > > pred_global_hist = pred_global;
if(prior == false){
std::fill(sample.begin(), sample.end(), 1);
}
arma::mat V(n, p);
IntegerVector rang;
bool no_site_order = (site_order[0] < 0);
if(no_site_order == false){
rang = site_order;
}
int index_px;
double norm;
double val_criterion = cv_criterion + 1;
double diff_criterion = 0, diff;
double cv_criterion2 = n * cv_criterion ;
int iter_updateV = 0 ;
vector < double > res_multipotentiel(n) ;
int iter = 0 ;
//// estimation
while(iter < iter_max && ( (val_criterion > cv_criterion) || (test_regional == true && iter_updateV != iter) ) ){
iter++;
pred_global_hist = pred_global;
if(no_site_order){
rang = rank_hpp(runif(n)) - 1; // tirer aleatoirement l ordre des sites
}
//// regional potential
if(test_regional == true){
if(iter == 1 || val_criterion <= cv_criterion || diff_criterion > cv_criterion2){
iter_updateV = iter ;
for(int iter_p = (p - 1) ; iter_p>= 0 ; iter_p --){
if(last_vs_others == false || iter_p == (p - 1)){
res_multipotentiel = calcMultiPotential_hpp(W_SR, W_LR, pred_global[iter_p],
threshold, coords, Rcpp::as < std::vector < double > >(distance_ref),
nbGroup_min, multiV,
neutre)[0];
for(int iter_px = 0 ; iter_px < n ; iter_px++){
V(iter_px, iter_p) = res_multipotentiel[iter_px];
if(type_reg){
V(iter_px, iter_p) = V(iter_px, iter_p) * (V(iter_px, iter_p) - pred_global[iter_p][iter_px]);
}
}
}else{
V.col(iter_p) = 1 - V.col(p - 1);
}
}
}else{
cv_criterion2 /= 1.1;
}
}
//// update site probabilities
val_criterion = 0;
diff_criterion = 0;
for(int iter_px = 0 ; iter_px < n ; iter_px++){ // pour chaque pixel
norm = 0.0;
index_px = rang(iter_px);
for(int iter_p = 0 ; iter_p < p ; iter_p++){ // pour chaque groupe
Wpred(index_px, iter_p) = 0.0;
for(int iter_vois = W_SRp[index_px]; iter_vois < W_SRp[index_px + 1]; iter_vois++){ // pour chaque voisin
if(type_reg){
Wpred(index_px, iter_p) += W_SRx[iter_vois]*pred_global[iter_p][W_SRi[iter_vois]]*max(0.0, pred_global[iter_p][W_SRi[iter_vois]]-sample(index_px, iter_p));
}else{
Wpred(index_px, iter_p) += W_SRx[iter_vois] *pred_global[iter_p][W_SRi[iter_vois]];
}
}
// exponentielle rho
if(test_regional == false){
pred_global[iter_p][index_px] = sample(index_px, iter_p) *exp(rho(0) *Wpred(index_px, iter_p)) ;
}else{
pred_global[iter_p][index_px] = sample(index_px, iter_p) *exp(rho(0) *Wpred(index_px, iter_p) + rho(1) *V(index_px, iter_p));
}
norm += pred_global[iter_p][index_px];
}
// normalisation
for(int iter_p = 0 ; iter_p < p ; iter_p++){
pred_global[iter_p][index_px] /= norm;
diff = abs(pred_global_hist[iter_p][index_px]-pred_global[iter_p][index_px]);
diff_criterion += diff;
val_criterion = max(val_criterion, diff);
}
}
if(verbose > 0){
if(verbose == 1){Rcout << "*" ;}
if(verbose == 2){Rcout << "iteration " << iter << " : totaldiff = " << diff_criterion << " | maxdiff = " << val_criterion << endl;}
}
}
if(verbose == 1){Rcout << endl;}
//// export
arma::mat spatialPrior(n, p);
for(int iter_px = 0 ; iter_px < n ; iter_px++){
index_px = rang(iter_px);
for(int iter_p = 0 ; iter_p < p ; iter_p++){
if(test_regional == false){
spatialPrior(index_px, iter_p) = exp(rho(0) *Wpred(index_px, iter_p)) ;
}else{
spatialPrior(index_px, iter_p) = exp(rho(0) *Wpred(index_px, iter_p) + rho(1) *V(index_px, iter_p));
}
}
}
return Rcpp::List::create(Rcpp::Named("predicted") = pred_global,
Rcpp::Named("spatialPrior") = spatialPrior,
Rcpp::Named("cv") = val_criterion <= cv_criterion,
Rcpp::Named("iter_max") = iter
);
}
////> Simulation functions ////
// [[Rcpp::export]]
List simulPotts_cpp (const S4& W_SR, const S4& W_LR, arma::mat sample, const arma::mat& coords,
const IntegerVector& site_order,
NumericVector rho, NumericVector distance_ref,
int iter_max, double cv_criterion, bool regional, bool verbose){
// attention W_SR est lu par lignes donc si elle doit etre normalisee c est par lignes !!!
//// initialization
// diagnostic progress
Progress testUser(verbose *CST_PROGRESS, verbose);
double value_trace = 0 ;
// variables
int n = sample.n_rows;
const int p = sample.n_cols;
vector < int > W_i = W_SR.slot("i");
vector < int > W_p = W_SR.slot("p");
vector < double > W_x = W_SR.slot("x");
IntegerVector rang(n);
bool no_site_order = (site_order[0] < 0);
if(no_site_order == false){
rang = site_order;
}
IntegerVector tirage_multinom(p); // int tirage_multinom[p]; // (generate a warning on linux : warning variable length arrays are a C99 feature)
NumericVector proba_site(p); //double proba_site[p]; // (generate a warning on linux : warning variable length arrays are a C99 feature)
int index_px;
arma::mat Wpred(n, p);
double norm;
// regional
arma::mat V(n, p);
std::fill(V.begin(), V.end(), 0);
vector < double > sampleCol(n);
List res_multipotentiel ;
// diagnostic convergence
bool check_cv = (cv_criterion > 0);
arma::mat proba_hist(check_cv *n, check_cv *p);
double val_criterion = cv_criterion + 1 ;
bool test;
//// main loop
for(int iter = 0; iter < iter_max ; iter++){
// diagnostic
if(verbose && iter>=value_trace){
value_trace = min(1.0 *iter_max, value_trace + iter_max / CST_PROGRESS);
testUser.increment();
}
if (Progress::check_abort() ){
sample.fill(NA_REAL);
V.fill(NA_REAL);
return Rcpp::List::create(Rcpp::Named("simulation") = sample,
Rcpp::Named("V") = V,
Rcpp::Named("cv") = false
);
}
// sort site order
if(no_site_order){
rang = rank_hpp(runif(n)) - 1; // tirer aleatoirement l ordre des sites
}
if(regional){ // regional potential
for(int iter_p = 0 ; iter_p < p ; iter_p++){
for(int iter_obs = 0 ; iter_obs < n ; iter_obs++){
sampleCol[iter_obs] = sample(iter_obs, iter_p); // colvec to vector < double >
}
for(int iter_px = 0 ; iter_px < n ; iter_px++){
res_multipotentiel = calcMultiPotential_hpp(W_SR, W_LR, sampleCol, 0.01,
coords, Rcpp::as < std::vector < double > >(distance_ref),
true, 10, 0.5);
V.col(iter_p) = as < arma::vec >(res_multipotentiel[0]);
}
}
}
for(int iter_px = 0 ; iter_px < n ; iter_px++){ // pour chaque pixel
norm = 0.0;
index_px = rang[iter_px];
for(int iter_p = 0 ; iter_p < p ; iter_p++){ // pour chaque groupe
Wpred(index_px, iter_p) = 0.0;
// contribution de chaque voisin a la densite
for(int iter_vois = W_p[index_px]; iter_vois < W_p[index_px + 1]; iter_vois++){
Wpred(index_px, iter_p) += W_x[iter_vois] *sample(W_i[iter_vois], iter_p);
}
// exponentielle rho
Wpred(index_px, iter_p) = exp(rho[0] * Wpred(index_px, iter_p) + rho[1] *V(index_px, iter_p)) ;
norm = norm + Wpred(index_px, iter_p);
}
for(int iter_p = 0; iter_p < p; iter_p++){
proba_site[iter_p] = Wpred(index_px, iter_p) / norm;
if(check_cv){
if(iter > 0){
test = abs(proba_hist(iter_px, iter_p) - proba_site[iter_p]) ;
if(test > val_criterion){val_criterion = test;}
proba_hist(iter_px, iter_p) = proba_site[iter_p];
}
}
}
rmultinom(1, proba_site.begin(), p, tirage_multinom.begin()); // rmultinom(1, proba_site, p, tirage_multinom); // (alternative version with the warning)
for(int iter_p = 0; iter_p < p; iter_p++){
sample(index_px, iter_p) = tirage_multinom[iter_p];
}
}
if(check_cv){
if(val_criterion < cv_criterion){break;}
}
}
// cv
bool test_cv;
if(check_cv){
test_cv = val_criterion < cv_criterion;
}else{
test_cv = NA_REAL;
}
// export
return Rcpp::List::create(Rcpp::Named("simulation") = sample,
Rcpp::Named("V") = V,
Rcpp::Named("cv_criterion") = cv_criterion,
Rcpp::Named("cv") = test_cv
);
}
void _computeItemTrace(vector<double> &itemtrace, const NumericMatrix &Theta,
const List &pars, const NumericVector &ot, const vector<int> &itemloc, const int &which,
const int &nfact, const int &N, const int &USEFIXED)
{
NumericMatrix theta = Theta;
int nfact2 = nfact;
S4 item = pars[which];
int ncat = as<int>(item.slot("ncat"));
vector<double> par = as< vector<double> >(item.slot("par"));
vector<double> P(N*ncat);
int itemclass = as<int>(item.slot("itemclass"));
int correct = 0;
if(itemclass == 8)
correct = as<int>(item.slot("correctcat"));
/*
1 = dich
2 = graded
3 = gpcm
4 = nominal
5 = grsm
6 = rsm
7 = partcomp
8 = nestlogit
9 = custom....have to do in R for now
*/
if(USEFIXED){
NumericMatrix itemFD = item.slot("fixed.design");
nfact2 = nfact + itemFD.ncol();
NumericMatrix NewTheta(Theta.nrow(), nfact2);
for(int i = 0; i < itemFD.ncol(); ++i)
NewTheta(_,i) = itemFD(_,i);
for(int i = 0; i < nfact; ++i)
NewTheta(_,i+itemFD.ncol()) = Theta(_,i);
theta = NewTheta;
}
switch(itemclass){
case 1 :
P_dich(P, par, theta, ot, N, nfact2);
break;
case 2 :
P_graded(P, par, theta, ot, N, nfact2, ncat-1, 1, 0);
break;
case 3 :
P_nominal(P, par, theta, ot, N, nfact2, ncat, 0, 0);
break;
case 4 :
P_nominal(P, par, theta, ot, N, nfact2, ncat, 0, 0);
break;
case 5 :
P_graded(P, par, theta, ot, N, nfact2, ncat-1, 1, 1);
break;
case 6 :
P_nominal(P, par, theta, ot, N, nfact2, ncat, 0, 1);
break;
case 7 :
P_comp(P, par, theta, N, nfact2);
break;
case 8 :
P_nested(P, par, theta, N, nfact2, ncat, correct);
break;
case 9 :
break;
default :
Rprintf("How in the heck did you get here from a switch statement?\n");
break;
}
int where = (itemloc[which]-1) * N;
for(int i = 0; i < N*ncat; ++i)
itemtrace[where + i] = P[i];
}