/** * direction: 0 -- copy values from @values to @ptr, * 1 -- copy values from @ptr to @values... */ SEXP assignDoubleMatrix(SEXP ptr, SEXP obsIndexes, SEXP varIndexes, SEXP values, SEXP direction){ //flush(cout); unsigned long varNum, obsNum, obsIndexNum, varIndexNum; AbstractMatrix * p = getAbstractMatrixFromSEXP(ptr); double coeff = 1. * length(obsIndexes) / p->getNumObservations(); unsigned long dir = (unsigned long) INTEGER(direction)[0]; double *currentValues = 0; if (!(coeff < WRITE_SPEED_PROPORTION)) { currentValues = new double[p->getNumObservations()]; } unsigned long varIndexesLength = length(varIndexes); unsigned long obsIndexesLength = length(obsIndexes); for(varIndexNum = 0; varIndexNum < varIndexesLength; varIndexNum ++){ varNum = (unsigned long)INTEGER(varIndexes)[varIndexNum]-1; if ( coeff < WRITE_SPEED_PROPORTION) { for(obsIndexNum = 0; obsIndexNum < obsIndexesLength; obsIndexNum ++){ obsNum = (unsigned long)INTEGER(obsIndexes)[obsIndexNum]-1; try { if (dir==0) { double value = REAL(values)[varIndexNum *obsIndexesLength + obsIndexNum]; p->writeElementAs(varNum, obsNum,value); } else { double value; p->readElementAs(varNum, obsNum,value); REAL(values)[varIndexNum *obsIndexesLength + obsIndexNum] = value; } } catch(int errorCode) { return R_NilValue; } } } else { try { if (dir==0) { p->readVariableAs(varNum, currentValues); for(obsIndexNum = 0; obsIndexNum < obsIndexesLength; obsIndexNum ++){ obsNum = (unsigned long)INTEGER(obsIndexes)[obsIndexNum] - 1; currentValues[obsNum] = REAL(values)[varIndexNum*obsIndexesLength+obsIndexNum]; } p->writeVariableAs(varNum, currentValues); } else { p->readVariableAs(varNum, currentValues); for(obsIndexNum = 0; obsIndexNum < obsIndexesLength; obsIndexNum ++){ obsNum = (unsigned long)INTEGER(obsIndexes)[obsIndexNum] - 1; REAL(values)[varIndexNum*obsIndexesLength+obsIndexNum] = currentValues[obsNum]; } } } catch(int errorCode){ delete [] currentValues; return R_NilValue; } } } if (!(coeff < WRITE_SPEED_PROPORTION)) { delete [] currentValues; } SEXP ret; PROTECT(ret = allocVector(LGLSXP, 1)); LOGICAL(ret)[0] = TRUE; UNPROTECT(1); //flush(cout); return ret; }