SEXP write_variable_double_FileMatrix_R(SEXP nvar, SEXP data, SEXP s) {
//testDbg << "write_variable_double_FileMatrix_R"<<endl;
AbstractMatrix * p = getAbstractMatrixFromSEXP(s);
if (p == NULL) {
error_R("pointer is NULL\n");
return R_NilValue;
}
unsigned long nvariable = (unsigned long) INTEGER(nvar)[0] - 1;
// here generally should be very careful -- what type of data is IN?
unsigned int nvars = 0;
unsigned int nobss = 0;
try {
nvars = p->getNumVariables();
} catch (int errocode) {
return R_NilValue;
}
if (nvariable <0 || nvariable >= nvars) {
error_R("nvar (%lu) out of range!\n",nvariable);
return R_NilValue;
}
try {
nobss = p->getNumObservations();
} catch (int errcode) {
return R_NilValue;
}
double * internal_data = new (std::nothrow) double [nobss];
if (internal_data == NULL) {
error_R("internal_data pointer is NULL\n");
return R_NilValue;
}
for (unsigned long i=0;i< nobss;i++) {
internal_data[i] = REAL(data)[i];
}
try {
p->writeVariableAs(nvariable, internal_data);
} catch (int errcode) {
delete [] internal_data;
error_R("can not write variable %ul\n",nvariable);
return R_NilValue;
}
SEXP ret;
PROTECT(ret = allocVector(LGLSXP, 1));
LOGICAL(ret)[0] = TRUE;
delete [] internal_data;
UNPROTECT(1);
return ret;
}
SEXP write_variable_double_FileMatrix_R(SEXP nvar, SEXP data, SEXP s) {
CHECK_PTR(s);
AbstractMatrix * p = (AbstractMatrix*) R_ExternalPtrAddr(s);
if (p == NULL) {
error_R("pointer is NULL\n");
return R_NilValue;
}
unsigned long int nvariable = (unsigned long int) INTEGER(nvar)[0];
// here generally should be very careful -- what type of data is IN?
unsigned int nvars = 0;
unsigned int nobss = 0;
try {
nvars = p->getNumVariables();
} catch (int errocode) {
return R_NilValue;
}
if (nvariable < 0 || nvariable >= nvars) {
error_R("nvar (%lu) out of range!\n", nvariable);
return R_NilValue;
}
try {
nobss = p->getNumObservations();
} catch (int errcode) {
return R_NilValue;
}
// float * internal_data = new (std::nothrow) float [nobss];
double internal_data[nobss];
if (internal_data == NULL) {
error_R("internal_data pointer is NULL\n");
return R_NilValue;
}
for (unsigned long int i = 0; i < nobss; i++) {
internal_data[i] = (double) REAL(data)[i];
}
// Rprintf("\n%lu, %lu\n",nvariable,nobss);
// for (unsigned long int i=0;i< nobss;i++) {
// Rprintf("%f ",internal_data[i]);
// }
try {
p->writeVariableAs(nvariable, internal_data);
} catch (int errcode) {
error_R("can not write variable %ul\n", nvariable);
}
SEXP ret;
PROTECT(ret = allocVector(LGLSXP, 1));
LOGICAL(ret)[0] = TRUE;
UNPROTECT(1);
return ret;
}
/**
* 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;
}
