SEXP read_variable_double_FileMatrix_R(SEXP nvar, SEXP s) { //testDbg << "read_variable_float_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; unsigned int nobs = 0; try { nobs = p->getNumObservations(); } catch (int errcode) { return R_NilValue; } double * internal_data = new (std::nothrow) double [nobs]; try { p->readVariableAs(nvariable, internal_data); } catch (int errcode) { return R_NilValue; } SEXP out; PROTECT(out = allocVector(REALSXP, (R_len_t) p->getNumObservations())); for (unsigned long i=0;i< nobs; i++) REAL(out)[i] = internal_data[i]; delete [] internal_data; UNPROTECT(1); return out; }
SEXP read_variable_float_FileMatrix_R(SEXP nvar, 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]; unsigned int nobs = 0; try { nobs = p->getNumObservations(); } catch (int errcode) { return R_NilValue; } float * internal_data = new (std::nothrow) float[nobs]; try { p->readVariableAs(nvariable, internal_data); } catch (int errcode) { return R_NilValue; } SEXP out; PROTECT(out = allocVector(REALSXP, (R_len_t) p->getNumObservations())); for (unsigned long int i = 0; i < nobs; i++) REAL(out)[i] = (double) internal_data[i]; UNPROTECT(1); delete[] internal_data; return out; }
SEXP get_nobs_R(SEXP s) { AbstractMatrix * p = getAbstractMatrixFromSEXP(s); if (p == NULL) { error_R("pointer is NULL\n"); return R_NilValue; } SEXP out; PROTECT(out = allocVector(INTSXP, 1)); unsigned int nobss = 0; try { nobss = (unsigned int) p->getNumObservations(); } catch (int errcode) { nobss = 0; } if (nobss<=0) { out = R_NilValue; } else { INTEGER(out)[0] = nobss; } UNPROTECT(1); return out; }
SEXP get_all_obsnames_R(SEXP s) { //testDbg << "get_all_obsnames_R"<<endl; AbstractMatrix * p = getAbstractMatrixFromSEXP(s); if (p == NULL) { error_R("pointer is NULL\n"); return R_NilValue; } //R_len_t nobss = (R_len_t) 0; unsigned long int nobss = 0; try { nobss = p->getNumObservations(); } catch (int errcode) { return R_NilValue; } FixedChar tmp; SEXP ret; PROTECT(ret = allocVector(STRSXP, (R_len_t) nobss)); try { for (unsigned long i = 0; i< nobss; i++) { tmp = p->readObservationName(i); SET_STRING_ELT(ret, i, mkChar(tmp.name)); } } catch (int errcode) { error_R("something went terribly wrong in get_all_obsnames_R\n"); UNPROTECT(1); return ret; } UNPROTECT(1); return ret; }
SEXP get_all_obsnames_R(SEXP s) { CHECK_PTR(s); AbstractMatrix * p = (AbstractMatrix*) R_ExternalPtrAddr(s); if (p == NULL) { error_R("pointer is NULL\n"); return R_NilValue; } R_len_t nobss = (R_len_t) 0; try { nobss = p->getNumObservations(); } catch (int errcode) { return R_NilValue; } fixedchar tmp; SEXP ret; PROTECT(ret = allocVector(STRSXP, (R_len_t) nobss)); try { for (unsigned long int i = 0; i < nobss; i++) { tmp = p->readObservationName(i); SET_STRING_ELT(ret, i, mkChar(tmp.name)); } } catch (int errcode) { error_R("something went terribly wrong in get_all_obsnames_R\n"); UNPROTECT(1); return ret; } UNPROTECT(1); return ret; }
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; }
void CorrectnessTest::testRandomReadObservations(){ testDbg << "testRandomReadObservations" << endl; string inputFile = getInputFileName(); string sumFileName = inputFile + string(".fvf_obssum"); AbstractMatrix* data = new FileVector ( inputFile, 64 ); testDbg << "Reading file:" << inputFile << endl; unsigned long numVariables = data->getNumVariables(); unsigned long numObservations = data->getNumObservations(); double *tmpdat = new (nothrow) double[numVariables]; testDbg << "Size is " << numVariables << " x " << numObservations << endl; int numObservationsToTest = 10; int observationIdx[numObservationsToTest]; unsigned long i; TestUtil::initRandomGenerator(); for (int i=0; i<numObservationsToTest; i++) { observationIdx[i] = (rand()*numObservations)/RAND_MAX; } ifstream sums(sumFileName.c_str()); testDbg << "Reading sum file: " << sumFileName << endl; CPPUNIT_ASSERT(sums.good()); double *sumData = new double[numVariables]; for(i=0; i<numObservations; i++) { sums >> sumData[i]; } for (i = 0 ; i < numObservationsToTest ; i++ ) { testDbg << i << "(" << observationIdx[i] << ")" << endl; data->readObservation(observationIdx[i], tmpdat); double calcSumm; calcSumm = summData(tmpdat, numVariables); double relDiff = TestUtil::relativeDifference(calcSumm,sumData[observationIdx[i]]); CPPUNIT_ASSERT(relDiff < 1E-2); } delete[] tmpdat; delete[] sumData; delete data; testDbg << "Finished" << endl; }
SEXP set_all_obsnames_R(SEXP s, SEXP names) { //testDbg << "set_all_obsnames_R"<<endl; AbstractMatrix * p = getAbstractMatrixFromSEXP(s); if (p == NULL) { error_R("pointer is NULL\n"); return R_NilValue; } //R_len_t nobss = (R_len_t) 0; unsigned long int nobss = 0; try { nobss = p->getNumObservations(); } catch (int errcode) { error_R("can not p->getNumObservations()\n"); return R_NilValue; } // check that length of SEXP names is the same!!! for (unsigned long i = 0; i < nobss; i++) { string obsname = CHAR(STRING_ELT(names,i)); try { p->writeObservationName(i,FixedChar(obsname)); } catch (int errcode) { error_R("can not set observation name for observation %ul\n",i); return R_NilValue; } } SEXP ret; PROTECT(ret = allocVector(LGLSXP, 1)); LOGICAL(ret)[0] = TRUE; UNPROTECT(1); return ret; }
// !!! SEXP set_all_obsnames_R(SEXP s, SEXP names) { CHECK_PTR(s); AbstractMatrix * p = (AbstractMatrix*) R_ExternalPtrAddr(s); if (p == NULL) { error_R("pointer is NULL\n"); return R_NilValue; } R_len_t nobss = (R_len_t) 0; try { nobss = p->getNumObservations(); } catch (int errcode) { error_R("can not p->getNumObservations()\n"); return R_NilValue; } // check that length of SEXP names is the same!!! for (unsigned long int i = 0; i < nobss; i++) { std::string obsname = CHAR(STRING_ELT(names, i)); try { p->writeObservationName(i, fixedchar(obsname)); } catch (int errcode) { error_R("can not set observation name for observation %ul\n", i); return R_NilValue; } } SEXP ret; PROTECT(ret = allocVector(LGLSXP, 1)); LOGICAL(ret)[0] = TRUE; UNPROTECT(1); return ret; }
void CorrectnessTest::testReadVariable() { string inputFile = getInputFileName(); AbstractMatrix *data = new FileVector( inputFile, 64 ); testDbg << "Reading file:" << inputFile << endl; unsigned long numVariables = data->getNumVariables(); unsigned long numObservations = data->getNumObservations(); testDbg << "Size is " << numVariables << " x " << numObservations << endl; double* tmpdat = new( nothrow ) double[numObservations]; string sumFileName = inputFile + string(".fvf_varsum"); ifstream sums(sumFileName.c_str()); testDbg << "Reading file: " << sumFileName << endl; CPPUNIT_ASSERT(sums.good()); unsigned long i; for ( i = 0 ; i < numVariables ; i++ ) { if (i%1000 == 0) testDbg << i << endl; data->readVariableAs(i, tmpdat); double calcSumm, realSumm; sums >> realSumm; calcSumm = summData(tmpdat,numObservations); CPPUNIT_ASSERT(TestUtil::relativeDifference(calcSumm,realSumm)<1E-4); } delete[] tmpdat; delete data; testDbg << "Finished" << endl; }
/** * 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; }
void CorrectnessTest::testSubMatrix() { string fileName = getInputFileName(); string subMatrixFileName = fileName + string(".fvf_submatrix"); string obsFileName = fileName + string(".fvf_obsnames"); string varFileName = fileName + string(".fvf_varnames"); testDbg << "obsFileName = " << obsFileName << endl; testDbg << "subMatrixFileName = " << subMatrixFileName << endl; AbstractMatrix *data = new FileVector ( fileName, 64 ); ifstream subMatrixData(subMatrixFileName.c_str()); ifstream obsNamesData(obsFileName.c_str()); ifstream varNamesData(varFileName.c_str()); CPPUNIT_ASSERT(subMatrixData.good()); CPPUNIT_ASSERT(obsNamesData.good()); CPPUNIT_ASSERT(varNamesData.good()); testDbg << "Reading file:" << fileName << endl; unsigned long numVariables = data->getNumVariables(); unsigned long numObservations = data->getNumObservations(); unsigned long i; testDbg << "Reading observations' names from " << obsFileName << endl; map<string, unsigned long> obsToIdx; for (i=0; i<numObservations; i++) { string obsName; obsNamesData >> obsName; obsToIdx[obsName] = i; } testDbg << "Reading variables' names from " << varFileName << endl; map<string, unsigned long> varToIdx; for (i=0; i<numVariables; i++) { string varName; varNamesData >> varName; varToIdx[varName] = i; } // indexes in order, specified in _submatrix file. vector<string> obsIdxesNames; testDbg << "Matrix size is " << data->getNumObservations() << " x " << data->getNumVariables() << endl; string obsNames; getline(subMatrixData, obsNames); tokenize(obsNames, obsIdxesNames); testDbg << "Submatrix width is:" << obsIdxesNames.size() << endl; vector<unsigned long> obsIdexes; for (i=0; i<obsIdxesNames.size(); i++){ obsIdexes.push_back(obsToIdx[obsIdxesNames[i]]); } vector<unsigned long> varIdxes; string subMatrixString; while (getline(subMatrixData, subMatrixString)) { string varName; vector<string> subMatrixElements; tokenize(subMatrixString, subMatrixElements); varName = subMatrixElements[0]; unsigned long varIdx = varToIdx[varName]; for (i = 0; i < obsIdxesNames.size(); i++) { double matrixElem; double submatrixElem; submatrixElem = atof(subMatrixElements[i+1].c_str()); data->readElementAs(varIdx, obsIdexes[i], matrixElem); double relDiff = TestUtil::relativeDifference(matrixElem, submatrixElem); CPPUNIT_ASSERT( relDiff = 0./0. || relDiff < 1E-4 ); } } delete data; }