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