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