//virtual void save(string new_file_name, unsigned long int nvars, unsigned long int nobss, unsigned long int * varindexes, unsigned long int * obsindexes)
SEXP save_R(SEXP New_file_name, SEXP IntPars, SEXP s) {
CHECK_PTR(s);
AbstractMatrix * p = (AbstractMatrix*) R_ExternalPtrAddr(s);
if (p == NULL) {
error_R("pointer is NULL\n");
return R_NilValue;
}
std::string new_file_name = CHAR(STRING_ELT(New_file_name, 0));
unsigned long int nvars = (unsigned long int) INTEGER(IntPars)[0];
unsigned long int nobss = (unsigned long int) INTEGER(IntPars)[1];
unsigned long int varindexes[nvars];
unsigned long int obsindexes[nobss];
for (unsigned long int i = 0; i < nvars; i++)
varindexes[i] = (unsigned long int) INTEGER(IntPars)[i + 2];
for (unsigned long int i = 0; i < nobss; i++)
obsindexes[i] = (unsigned long int) INTEGER(IntPars)[i + 2 + nvars];
try {
p->saveAs(new_file_name, nvars, nobss, varindexes, obsindexes);
} catch (int errcode) {
error_R("can not save data to file %s\n", new_file_name.c_str());
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) {
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 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_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 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 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_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 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;
}
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;
}
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;
}
typename Cholesky<Matrix>::DMatrix Cholesky<Matrix>::doSolve( const AbstractMatrix& b )
{
if ( this->rowNum() != b.rows() )
{
std::cerr<<"The order of matrix is "<<this->rowNum()<<" and the dimension of vector is "<<b.rows()<<std::endl;
throw COException("Cholesky solving error: the size if not consistent!");
}
DMatrix result(b);
copt_lapack_potrs('U',this->rowNum(),b.cols(),__a,this->lda(),result.dataPtr(),result.lda(),&__info);
if ( __info != 0 )
std::cerr<<"Warning in Cholesky solver: solving is wrong!"<<std::endl;
return result;
}
//virtual void save(string newFilename, unsigned long nvars, unsigned long nobss, unsigned long * varindexes, unsigned long * obsindexes)
SEXP save_R(SEXP New_file_name, SEXP IntPars, SEXP s)
{
// dbg<<"save_R"<<endl;
AbstractMatrix * p = getAbstractMatrixFromSEXP(s);
if (p == NULL) {
error_R("pointer is NULL\n");
return R_NilValue;
}
string newFilename = CHAR(STRING_ELT(New_file_name,0));
unsigned long nvars = (unsigned long) INTEGER(IntPars)[0];
unsigned long nobss = (unsigned long) INTEGER(IntPars)[1];
unsigned long * varindexes = new (std::nothrow) unsigned long [nvars];
if (varindexes == NULL) {
error_R("pointer is NULL\n");
return R_NilValue;
}
unsigned long * obsindexes = new (std::nothrow) unsigned long [nobss];
if (obsindexes == NULL) {
error_R("pointer is NULL\n");
delete [] varindexes;
return R_NilValue;
}
for (unsigned long i = 0; i < nvars; i++)
varindexes[i] = (unsigned long) INTEGER(IntPars)[i+2];
for (unsigned long i = 0; i < nobss; i++) {
obsindexes[i] = (unsigned long) INTEGER(IntPars)[i+2+nvars];
}
try {
p->saveAs(newFilename,nvars,nobss,varindexes,obsindexes);
} catch (int errcode) {
error_R("can not save data to file %s\n",newFilename.c_str());
delete [] obsindexes;
delete [] varindexes;
return R_NilValue;
}
SEXP ret;
PROTECT(ret = allocVector(LGLSXP, 1));
LOGICAL(ret)[0] = TRUE;
delete [] obsindexes;
delete [] varindexes;
UNPROTECT(1);
return ret;
}
SEXP setReadOnly_R(SEXP s, SEXP readOnly) {
AbstractMatrix * p = getAbstractMatrixFromSEXP(s);
if (p == NULL) {
error_R("pointer is NULL\n");
return R_NilValue;
}
bool readonly = LOGICAL(readOnly)[0];
bool result = p->setReadOnly(readonly);
SEXP ret;
PROTECT(ret = allocVector(LGLSXP, 1));
LOGICAL(ret)[0] = result?TRUE:FALSE;
UNPROTECT(1);
return ret;
}
// !!!
SEXP set_cachesizeMb_R(SEXP s, SEXP SizeMB)
{
//testDbg << "set_cachesizeMb_R"<<endl;
AbstractMatrix * p = getAbstractMatrixFromSEXP(s);
if (p == NULL) {
error_R("pointer is NULL\n");
return R_NilValue;
}
unsigned long sizeMb = (unsigned long) INTEGER(SizeMB)[0];
try {
p->setCacheSizeInMb( sizeMb );
} catch (int errcode) {
error_R("cannot reset cache size\n");
return R_NilValue;
}
SEXP ret;PROTECT(ret = allocVector(LGLSXP, 1));LOGICAL(ret)[0] = TRUE;UNPROTECT(1);
return ret;
}
SEXP get_cachesizeMb_R(SEXP s)
{
AbstractMatrix * p = getAbstractMatrixFromSEXP(s);
if (p == NULL) {
error_R("pointer is NULL\n");
return R_NilValue;
}
unsigned long sizeMb = 0;
try {
sizeMb = p->getCacheSizeInMb();
} catch (int errcode) {
return R_NilValue;
}
SEXP out;
PROTECT(out = allocVector(INTSXP, 1));
INTEGER(out)[0] = (int) sizeMb;
UNPROTECT(1);
return(out);
}
// !!!
SEXP set_cachesizeMb_R(SEXP s, SEXP SizeMB) {
CHECK_PTR(s);
AbstractMatrix * p = (AbstractMatrix*) R_ExternalPtrAddr(s);
if (p == NULL) {
error_R("pointer is NULL\n");
return R_NilValue;
}
unsigned long int sizeMb = (unsigned long int) INTEGER(SizeMB)[0];
try {
p->setCacheSizeInMb(sizeMb);
} catch (int errcode) {
error_R("cannot reset cache size\n");
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;
}
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 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;
}
SEXP saveAsText(SEXP s, SEXP New_file_name, SEXP IntPars, SEXP NANString ) {
AbstractMatrix * p = getAbstractMatrixFromSEXP(s);
if (p == NULL) {
error_R("pointer is NULL\n");
return R_NilValue;
}
string newFilename = CHAR(STRING_ELT(New_file_name,0));
string nanString = CHAR(STRING_ELT(NANString,0));
bool showVarNames = LOGICAL(IntPars)[0];
bool showObsNames = LOGICAL(IntPars)[1];
bool transpose = LOGICAL(IntPars)[2];
AbstractMatrix *transposed = p;
string tmpFileName,tmpFileName2;
if (!transpose){
Transposer transposer;
tmpFileName= p->getFileName() + string("_saveAsText_tmp");
tmpFileName2= p->getFileName() + string("_saveAsText_tmp2");
p->saveAs(tmpFileName);
transposer.process(tmpFileName, tmpFileName2, true);
transposed = new FileVector(tmpFileName2, p->getCacheSizeInMb());
}
try {
transposed->saveAsText(newFilename, showVarNames, showObsNames, nanString);
} catch (int errcode) {
error_R("can not save data to file %s\n",newFilename.c_str());
return R_NilValue;
}
if (!transpose){
delete transposed;
unlink(tmpFileName.c_str());
unlink(tmpFileName2.c_str());
}
SEXP ret;
PROTECT(ret = allocVector(LGLSXP, 1));
LOGICAL(ret)[0] = TRUE;
UNPROTECT(1);
return ret;
}
void QRDecomposition<T>::operator()(const AbstractMatrix<T>& aMatrix)
{
q = DenseMatrix<T>(aMatrix.numRows(), aMatrix.numRows());
r = UpperTriangularMatrix<T>(aMatrix.numRows());
T normResult;
TwoNorm<T> norm;
for(int i = 0; i < aMatrix.numRows(); i++)
{
for(int j = 0; j < aMatrix.numRows(); j++)
{
q(i, j) = 0;
r(i, j) = 0;
}
}
for(int i = 0; i < aMatrix.numRows(); i++)
{
if(i == 0)
{
normResult = norm(aMatrix.getColumn(0));
if(normResult == 0)
{
throw std::domain_error("Error in QRDecomposition: Attempted division by zero");
}
for(int j = 0; j < aMatrix.numRows(); j++)
{
q(j, 0) = aMatrix(j, 0) * (1 / normResult);
}
}
else
{
Vector<T> temp(aMatrix.numRows());
temp = r(0, i) * q.getColumn(0);
for(int k = 1; k < i; k++)
{
temp += r(k, i) * q.getColumn(k);
}
temp = aMatrix.getColumn(i) - temp;
r(i, i) = norm(temp);
if(r(i, i) == 0)
{
throw std::domain_error("QRDecomposition: Attempted division by zero");
}
for(int j = 0; j < aMatrix.numRows(); j++)
{
q(j, i) = (1 / r(i, i)) * temp[j];
}
}
for(int j = 0; j < aMatrix.numRows(); j++)
{
r(i, j) = aMatrix.getColumn(j) * q.getColumn(i);
}
}
}
void operator()(AbstractMatrix<M>& m) const {
assert_square(m);
fill(m, 0);
for (int i=0; i<m.rows(); ++i)
m(i,i) = 1;
}
/**
* 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 operator()(AbstractMatrix<M>& m) const {
for (int i=0; i<m.rows(); ++i)
for (int j=0; j<m.cols(); ++j)
m(i,j) = rand() * a - b;
}
void QRDecomposition<T>::operator()(const AbstractMatrix<T>& aMatrix)
{
q = GenericMatrix<T>(aMatrix.rows());
r = TriangularMatrix<T>(aMatrix.rows(), TRIANGLE_TYPE::UPPER);
T normResult;
TwoNorm<T> norm;
/*for(int i = 0; i < aMatrix.rows(); i++)
{
for(int j = 0; j < aMatrix.rows(); j++)
{
q[i][j] = 0;
r[i][j] = 0;
//q(i, j) = 0;
//r(i, j) = 0;
}
}*/
int rows = static_cast<int>(aMatrix.rows());
for(int i = 0; i < rows; i++)
{
if(i == 0)
{
normResult = norm(aMatrix.getColumn(0));
if(normResult == 0)
{
throw std::domain_error("Error in QRDecomposition: Attempted division by zero");
}
for(int j = 0; j < rows; j++)
{
q[j][0] = aMatrix[j][0] * (1 / normResult);
}
}
else
{
AlgebraVector<T> temp(aMatrix[0]);
temp = r[0][i] * q.getColumn(0);
//temp = r(0, i) * q.getColumn(0);
for(int k = 1; k < i; k++)
{
temp += r[k][i] * q.getColumn(k);
//temp += r(k, i) * q.getColumn(k);
}
temp = aMatrix.getColumn(i) - temp;
r[i][i] = norm(temp);
//r(i, i) = norm(temp);
//if(r(i, i) == 0)
if(r[i][i] == 0)
{
throw std::domain_error("QRDecomposition: Attempted division by zero");
}
for(int j = 0; j < rows; j++)
{
q[j][i] = (1 / r[i][i]) * temp[j];
//q(j, i) = (1 / r(i, i)) * temp[j];
}
}
for(int j = 0; j < rows; j++)
{
r[i][j] = aMatrix.getColumn(j) * q.getColumn(i);
//r(i, j) = aMatrix.getColumn(j) * q.getColumn(i);
}
}
}
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;
}
