SEXP get_nvars_R(SEXP s) { // cout << "get_nvars_R()" << endl; 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 nvars = 0; try { nvars = (unsigned int) p->getNumVariables(); } catch (int errcode) { nvars = 0; } if (nvars<=0) { out = R_NilValue; } else { INTEGER(out)[0] = nvars; } UNPROTECT(1); return out; }
SEXP get_nvars_R(SEXP s) { CHECK_PTR(s); AbstractMatrix * p = (AbstractMatrix*) R_ExternalPtrAddr(s); if (p == NULL) { error_R("pointer is NULL\n"); return R_NilValue; } SEXP out; PROTECT(out = allocVector(INTSXP, 1)); unsigned int nvars = 0; try { nvars = (unsigned int) p->getNumVariables(); } catch (int errcode) { nvars = 0; } if (nvars <= 0) { out = R_NilValue; } else { INTEGER(out)[0] = nvars; } UNPROTECT(1); return out; }
SEXP get_all_varnames_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 nvars = (R_len_t) 0; try { nvars = p->getNumVariables(); } catch (int errcode) { return R_NilValue; } fixedchar tmp; SEXP ret; PROTECT(ret = allocVector(STRSXP, (R_len_t) nvars)); try { for (unsigned long int i = 0; i < nvars; i++) { tmp = p->readVariableName(i); SET_STRING_ELT(ret, i, mkChar(tmp.name)); } } catch (int errcode) { error_R("something went terribly wrong in get_all_varnames_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_varnames_R(SEXP s, SEXP names) { // testDbg << "set_all_varnames_R"<<endl; AbstractMatrix * p = getAbstractMatrixFromSEXP(s); if (p == NULL) { error_R("pointer is NULL\n"); return R_NilValue; } // R_len_t nvars = (R_len_t) 0; unsigned long nvars = 0; try { nvars = p->getNumVariables(); } catch (int errcode) { error_R("can not p->getNumVariables()\n"); return R_NilValue; } // check that length of SEXP names is the same!!! for (unsigned long i = 0; i < nvars; i++) { string varname = CHAR(STRING_ELT(names,i)); try { p->writeVariableName(i,FixedChar(varname)); } catch (int errcode) { error_R("can not set variable name for variable %ul\n",i); return R_NilValue; } } SEXP ret; PROTECT(ret = allocVector(LGLSXP, 1)); LOGICAL(ret)[0] = TRUE; UNPROTECT(1); return ret; }
// !!! SEXP set_all_varnames_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 nvars = (R_len_t) 0; try { nvars = p->getNumVariables(); } catch (int errcode) { error_R("can not p->getNumVariables()\n"); return R_NilValue; } // check that length of SEXP names is the same!!! for (unsigned long int i = 0; i < nvars; i++) { std::string varname = CHAR(STRING_ELT(names, i)); try { p->writeVariableName(i, fixedchar(varname)); } catch (int errcode) { error_R("can not set variable name for variable %ul\n", i); return R_NilValue; } } SEXP ret; PROTECT(ret = allocVector(LGLSXP, 1)); LOGICAL(ret)[0] = TRUE; UNPROTECT(1); return ret; }
SEXP get_all_varnames_R(SEXP s) { // testDbg << "get_all_varnames_R" << endl; AbstractMatrix * p = getAbstractMatrixFromSEXP(s); if (p == NULL) { error_R("pointer is NULL\n"); return R_NilValue; } //R_len_t nvars = (R_len_t) 0; unsigned long int nvars = 0; try { nvars = p->getNumVariables(); } catch (int errcode) { return R_NilValue; } FixedChar tmp; SEXP ret; //cout << "get_all_varnames.nvars=" << nvars << endl; PROTECT(ret = allocVector(STRSXP, (R_len_t) nvars)); //cout << "alloc done" << endl; try { for (unsigned long i = 0; i< nvars; i++) { tmp = p->readVariableName(i); SET_STRING_ELT(ret, i, mkChar(tmp.name)); } } catch (int errcode) { error_R("something went terribly wrong in get_all_varnames_R\n"); UNPROTECT(1); return ret; } 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; }
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; }