[Genabel-commits] r677 - pkg/VariABEL/src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Mar 7 15:28:32 CET 2011
Author: maksim
Date: 2011-03-07 15:28:32 +0100 (Mon, 07 Mar 2011)
New Revision: 677
Added:
pkg/VariABEL/src/AbstractMatrix.cpp
pkg/VariABEL/src/AbstractMatrix.h
pkg/VariABEL/src/AbstractMatrix_R.cpp
pkg/VariABEL/src/CastUtils.cpp
pkg/VariABEL/src/CastUtils.h
pkg/VariABEL/src/FileVector.cpp
pkg/VariABEL/src/FileVector.h
pkg/VariABEL/src/FilteredMatrix.cpp
pkg/VariABEL/src/FilteredMatrix.h
pkg/VariABEL/src/FilteredMatrix_R.cpp
pkg/VariABEL/src/Logger.cpp
pkg/VariABEL/src/Logger.h
pkg/VariABEL/src/RealHandlerWrapper.cpp
pkg/VariABEL/src/RealHandlerWrapper.h
pkg/VariABEL/src/ReusableFileHandle.cpp
pkg/VariABEL/src/ReusableFileHandle.h
pkg/VariABEL/src/Rstaff.h
pkg/VariABEL/src/Transposer.cpp
pkg/VariABEL/src/Transposer.h
pkg/VariABEL/src/const.h
pkg/VariABEL/src/constants.h
pkg/VariABEL/src/convert_util.cpp
pkg/VariABEL/src/convert_util.h
pkg/VariABEL/src/dautil.cpp
pkg/VariABEL/src/dautil.h
pkg/VariABEL/src/frutil.cpp
pkg/VariABEL/src/frutil.h
pkg/VariABEL/src/frversion.h
pkg/VariABEL/src/fvflib.uxf
pkg/VariABEL/src/gtps_container.cpp
pkg/VariABEL/src/gtps_container.h
pkg/VariABEL/src/inverse_variance_metaanalysis.cpp
pkg/VariABEL/src/inverse_variance_metaanalysis.h
pkg/VariABEL/src/iterator.cpp
pkg/VariABEL/src/iterator.h
pkg/VariABEL/src/iterator_functions.cpp
pkg/VariABEL/src/iterator_functions.h
pkg/VariABEL/src/linear_regression.cpp
pkg/VariABEL/src/linear_regression.h
pkg/VariABEL/src/supplementary_functions.cpp
pkg/VariABEL/src/supplementary_functions.h
pkg/VariABEL/src/var_homogeneity_test_C.cpp
pkg/VariABEL/src/var_homogeneity_tests.cpp
pkg/VariABEL/src/var_homogeneity_tests.h
pkg/VariABEL/src/var_meta_gwaa_C.cpp
Log:
all file in one dir
Added: pkg/VariABEL/src/AbstractMatrix.cpp
===================================================================
--- pkg/VariABEL/src/AbstractMatrix.cpp (rev 0)
+++ pkg/VariABEL/src/AbstractMatrix.cpp 2011-03-07 14:28:32 UTC (rev 677)
@@ -0,0 +1,20 @@
+#include "AbstractMatrix.h"
+
+set<string> AbstractMatrix::fileNamesOpenForWriting;
+
+void AbstractMatrix::checkOpenForWriting(const string fileName){
+ deepDbg << "checkOpenForWriting("<< fileName << ")" << endl;
+ if (AbstractMatrix::fileNamesOpenForWriting.find(fileName) != fileNamesOpenForWriting.end()) {
+ errorLog << "File " << fileName << " is already opened." << endl;
+ throw 1;
+ } else {
+ AbstractMatrix::fileNamesOpenForWriting.insert(fileName);
+ }
+}
+void AbstractMatrix::closeForWriting(const string fileName){
+ fmDbg << "closeForWriting("<< fileName << ")" << endl;
+ AbstractMatrix::fileNamesOpenForWriting.erase(fileName);
+}
+
+
+
Added: pkg/VariABEL/src/AbstractMatrix.h
===================================================================
--- pkg/VariABEL/src/AbstractMatrix.h (rev 0)
+++ pkg/VariABEL/src/AbstractMatrix.h 2011-03-07 14:28:32 UTC (rev 677)
@@ -0,0 +1,130 @@
+#ifndef __AbstractMatrix__
+#define __AbstractMatrix__
+
+#include <string>
+#include <set>
+
+using namespace std;
+
+#include "frutil.h"
+#include "CastUtils.h"
+
+#define WRITE_SPEED_PROPORTION .01
+
+// See filteredMatrix.h for detailed comments
+
+class AbstractMatrix {
+public:
+ virtual ~AbstractMatrix(){};
+
+ template <class DT>
+ void writeVariableAs(unsigned long varIdx, DT * outvec)
+ {
+ char* tmp = new (nothrow) char [getNumObservations()*getElementSize()];
+ if(!tmp)
+ errorLog << "writeVariableAs allocation error" << errorExit;
+ for(unsigned long int i = 0; i< getNumObservations();i++){
+ performCast(&tmp[i*getElementSize()],outvec[i],getElementType(), warningIsShown);
+ }
+ writeVariable(varIdx, tmp);
+ delete[] tmp;
+ }
+
+ template <class DT>
+ void addVariableAs(DT * outvec, string varname)
+ {
+ char* tmp = new (nothrow) char [getNumObservations()*getElementSize()];
+ if(!tmp)
+ errorLog << "add_variable_as allocation error" << errorExit;
+ for(unsigned long int i = 0; i< getNumObservations();i++){
+ performCast(&tmp[i*getElementSize()],outvec[i],getElementType(), warningIsShown);
+ }
+ addVariable (tmp, varname);
+ delete[] tmp;
+ }
+
+ template<class DT>
+ void readVariableAs(unsigned long varIdx, DT * outvec)
+ {
+ char * tmp = new (nothrow) char[getNumObservations()*getElementSize()];
+ readVariable(varIdx, tmp);
+ for(unsigned long int i = 0; i< getNumObservations();i++) {
+ performCast(outvec[i],&tmp[i*getElementSize()],getElementType(),warningIsShown);
+ }
+ delete[] tmp;
+ }
+
+ template<class DT>
+ void readElementAs(unsigned long varNumber, unsigned long obsNumber, DT & element){
+ char *ret= new char [getElementSize()];
+ readElement(varNumber, obsNumber, ret);
+ performCast(element, ret, getElementType(), warningIsShown);
+ delete [] ret;
+ }
+
+ template <class DT>
+ void writeElementAs(unsigned long varNumber, unsigned long obsNumber, DT& element){
+ deepDbg << "AbstractMatrix.writeElementAs(" << varNumber << "," << obsNumber << "," << element <<")";
+ deepDbg << "Alloc getElementSize() = " << getElementSize() << endl;
+ char *ret = new char [getElementSize()];
+ deepDbg << "Perform cast" << endl;
+ performCast(ret, element, getElementType(), warningIsShown);
+ writeElement(varNumber, obsNumber, ret);
+ delete [] ret;
+ }
+
+ virtual string getFileName() = 0;
+
+ virtual unsigned long getNumVariables() = 0;
+ virtual unsigned long getNumObservations() = 0;
+
+ virtual void saveAs( string newFilename ) = 0;
+ virtual void saveVariablesAs( string newFilename, unsigned long nvars, unsigned long * varindexes) = 0;
+ virtual void saveObservationsAs( string newFilename, unsigned long nobss, unsigned long * obsindexes) = 0;
+
+ virtual void saveAs(string newFilename, unsigned long nvars, unsigned long nobss, unsigned long * varindexes, unsigned long * obsindexes) = 0;
+ virtual void saveAsText(string newFilename, bool saveVarNames, bool saveObsNames, string nanString) = 0;
+
+ virtual void readObservation(unsigned long obsIdx, void * outvec) = 0;
+ virtual void writeObservation(unsigned long obsIdx, void * invec) = 0;
+
+ virtual void writeVariableName(unsigned long varIdx, FixedChar newname) = 0; // todo loooong future -- control that name is unique
+ virtual void writeObservationName(unsigned long obsIdx, FixedChar newname)= 0; //todo loooong future -- control that name is unique!
+
+ virtual unsigned long getCacheSizeInMb() = 0;
+ virtual void setCacheSizeInMb( unsigned long cachesizeMb ) = 0;
+
+ virtual FixedChar readObservationName(unsigned long obsIdx) = 0;
+ virtual FixedChar readVariableName(unsigned long varIdx) = 0;
+ virtual void cacheAllNames(bool) = 0;
+
+ virtual void setUpdateNamesOnWrite(bool bUpdate) = 0;
+ virtual short unsigned getElementSize() = 0;
+ virtual short unsigned getElementType() = 0;
+ virtual void readVariable(unsigned long varIdx, void * outvec) = 0;
+ virtual void readElement(unsigned long varIdx, unsigned long obsIdx, void * elem) = 0;
+ virtual void writeVariable(unsigned long varIdx, void * datavec) = 0;
+ virtual void writeElement(unsigned long varIdx, unsigned long obsIdx, void * data) = 0;
+ virtual AbstractMatrix* castToAbstractMatrix() = 0;
+ virtual bool setReadOnly(bool readOnly) = 0;
+
+ static set<string> fileNamesOpenForWriting;
+ static void checkOpenForWriting(const string fileName);
+ static void closeForWriting(const string fileName);
+
+ bool &getWarningIsShown(){ return warningIsShown;}
+private:
+
+ // HIGH -- here I see the possibility to make these functions faster then "random" access functions
+ // adds variable at the end = writeVariable with varIdx=NVARS?
+ // todo loooong future -- control that name is unique!
+ virtual void addVariable(void * invec, string varname) = 0;
+ // virtual void add_observation(void * invec, string obsname) = 0;
+ // write single element
+ // CURRENTLY CACHE IS NOT UPDATED!
+ bool warningIsShown;
+};
+
+#endif
+
+
Added: pkg/VariABEL/src/AbstractMatrix_R.cpp
===================================================================
--- pkg/VariABEL/src/AbstractMatrix_R.cpp (rev 0)
+++ pkg/VariABEL/src/AbstractMatrix_R.cpp 2011-03-07 14:28:32 UTC (rev 677)
@@ -0,0 +1,744 @@
+#include "Rstaff.h"
+
+#include "FilteredMatrix.h"
+#include "Logger.h"
+
+// must be included after c++ headers!
+#include <stdio.h>
+#include <Rdefines.h>
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+ void checkPointer(SEXP s) {
+ if (TYPEOF(s) != EXTPTRSXP) {
+ errorLog << "Pointer is not EXTPTRSXP" << endl << errorExit;
+ }
+ if (R_ExternalPtrTag(s) != install("AbstractMatrix") && R_ExternalPtrTag(s) != install("FilteredMatrix")) {
+ errorLog << "R_ExternalPtrTag(s) = " << (void*)R_ExternalPtrTag(s) << endl;
+ errorLog << "Pointer is not AbstractMatrix nor FilteredMatrix" << endl << errorExit;
+ }
+ }
+
+ AbstractMatrix *getAbstractMatrixFromSEXP(SEXP s){
+ checkPointer(s);
+ if (TYPEOF(s) == EXTPTRSXP) {
+ return ((AbstractMatrix*)R_ExternalPtrAddr(s))->castToAbstractMatrix();
+ }
+ errorLog << "External pointer not valid!" << endl << errorExit ;
+ return NULL;
+ }
+
+ 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_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 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 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;
+ }
+
+ // !!!
+ 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 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 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;
+
+ }
+
+ static void AbstractMatrixRFinalizer(SEXP x) {
+ if (x == R_NilValue) return;
+ AbstractMatrix* p = (AbstractMatrix *) EXTPTR_PTR(x);
+ if (p == NULL) return;
+ wrapperLog << "finalizing AbstractMatrix: " << (void*)p << endl;
+ delete p;
+ }
+
+ SEXP disconnect_R(SEXP s) {
+ AbstractMatrixRFinalizer(s);
+ R_ClearExternalPtr(s);
+ return R_NilValue;
+ }
+
+ SEXP externalptr_is_null(SEXP s) {
+ checkPointer(s);
+ AbstractMatrix * p = (AbstractMatrix*)R_ExternalPtrAddr(s);
+ SEXP ret;
+ PROTECT(ret = allocVector(LGLSXP, 1));
+ LOGICAL(ret)[0] = FALSE;
+ if (p == NULL) LOGICAL(ret)[0] = TRUE;
+ UNPROTECT(1);
+ return ret;
+ }
+
+ SEXP open_FileMatrix_R(SEXP fname, SEXP cacheMb, SEXP ReadOnly) {
+ unsigned long cachesizeMb = (unsigned long) INTEGER(cacheMb)[0];
+ bool readonly = LOGICAL(ReadOnly)[0];
+ string filename = CHAR(STRING_ELT(fname,0));
+ if (cachesizeMb<0) {
+ error_R("negative cache size\n");
+ return R_NilValue;
+ }
+
+ AbstractMatrix* p = NULL;
+
+ try {
+ p = new FileVector(filename,cachesizeMb,readonly);
+ cout << "open_FileMatrix_R, ptr = " << (void*)p << endl;
+ } catch (int errcode) {
+ return R_NilValue;
+ }
+
+ if (p == NULL) {
+ error_R("pointer is NULL\n");
+ return R_NilValue;
+ }
+ SEXP val = R_MakeExternalPtr(p, Rf_install("AbstractMatrix"), R_NilValue);
+ R_RegisterCFinalizerEx(val, AbstractMatrixRFinalizer, (Rboolean) TRUE);
+ return val;
+ }
+
+ 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;
+ }
+
+ /// magic number 9007199254740993, minimum value when (float)(x+1) != x
+
+ 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 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 text2fvf_R(SEXP Fnames, SEXP IntPars)
+ {
+ string program_name = "text2fvf_R";
+ string infilename = CHAR(STRING_ELT(Fnames,0));
+ string outfilename = CHAR(STRING_ELT(Fnames,1));
+ string rownamesfilename = CHAR(STRING_ELT(Fnames,2));
+ string colnamesfilename = CHAR(STRING_ELT(Fnames,3));
+ unsigned long rownames = (unsigned long) INTEGER(IntPars)[0];
+ unsigned long colnames = (unsigned long) INTEGER(IntPars)[1];
+ unsigned long skiprows = (unsigned long) INTEGER(IntPars)[2];
+ unsigned long skipcols = (unsigned long) INTEGER(IntPars)[3];
+ int transpose = (int) INTEGER(IntPars)[4];
+ int Rmatrix = (int) INTEGER(IntPars)[5];
+ unsigned short Type = (unsigned short ) INTEGER(IntPars)[6];
+ string nanString = CHAR(STRING_ELT(Fnames,4));
+
+ try {
+ text2fvf(program_name,
+ infilename, outfilename,
+ rownamesfilename, colnamesfilename,
+ rownames, colnames,
+ skiprows, skipcols,
+ transpose, Rmatrix, Type, false, nanString);
+ } catch (int x) {
+ error_R("failed in text2fvf_R\n");
+ return R_NilValue;
+ }
+
+ SEXP ret;PROTECT(ret = allocVector(LGLSXP, 1));LOGICAL(ret)[0] = TRUE;UNPROTECT(1);
+ return ret;
+ }
+
+ SEXP ini_empty_FileMatrix_R(SEXP fname, SEXP nvars, SEXP nobs, SEXP Type)
+ {
+ unsigned long numVariables = (unsigned long) INTEGER(nvars)[0];
+ unsigned long nobservations = (unsigned long) INTEGER(nobs)[0];
+ string filename = CHAR(STRING_ELT(fname,0));
+ unsigned short int type = (unsigned short int) INTEGER(Type)[0];
+
+ if (type <=0 || type > 8) {
+ error_R("Unknown data type %u\n",type);
+ return R_NilValue;
+ }
+ try {
+ // last flag -- override
+ initializeEmptyFile(filename, numVariables, nobservations, type, false);
+ } catch (int errcode) {
+ error_R("failed in ini_empty_FileMatrix_R");
+ return R_NilValue;
+ }
+
+ SEXP ret;
+ PROTECT(ret = allocVector(LGLSXP, 1));
+ LOGICAL(ret)[0] = TRUE;
+ UNPROTECT(1);
+ return ret;
+
+ }
+
+ //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 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;
+ }
+
+ SEXP checkNumBits(){
+ if (sizeof(unsigned long) != 8) {
+ errorLog << "YOU APPEAR TO WORK ON 32-BIT SYSTEM. LARGE FILES ARE NOT SUPPORTED."<<endl;
+ }
+ return R_NilValue;
+ }
+
+ /**
+ * 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;
+ }
+
+
+
+#ifdef __cplusplus
+}
+#endif
+//
+// OLD STRANGE STAFF
+//
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+ // .Fortran("dqrls",
+ // qr = x, n = n, p = p,
+ // y = tra, ny = ny,
+ // tol = as.double(tol),
+ // coefficients = mat.or.vec(p, ny),
+ // residuals = y, effects = y, rank = integer(1L),
+ // pivot = 1L:p, qraux = double(p), work = double(2*p),
+ // PACKAGE="base")$coefficients[2]
+
+ void dqrls_(
+ double*, int*, int*,
+ double*, int*,
+ double*,
+ double*,
+ double*, double*, int*,
+ int*, double*, double*
+ );
+
+ // .Fortran("ch2inv", x = x, nr, size, v = matrix(0, nrow = size,
+ // ncol = size), info = integer(1L), DUP = FALSE, PACKAGE = "base")
+ void ch2inv_(
+ double*,int*,int*,double*,int*
+ );
+
+
+ // subroutine dqrls(x,n,p,y,ny,tol,b,rsd,qty,k,jpvt,qraux,work)
+ // integer n,p,ny,k,jpvt(p)
+ // double precision x(n,p),y(n,ny),tol,b(p,ny),rsd(n,ny),
+ // . qty(n,ny),qraux(p),work(p)
+
+ void CPP_dqrls(
+ double * x, int * n, int * p,
+ double * y, int * ny,
+ double * tol,
+ double * b,
+ double * rsd, double * qty, int * k,
+ int * jpvt, double * qraux, double * work
+ )
+ {
+ dqrls_(x,n,p,y,ny,tol,b,rsd,qty,k,jpvt,qraux,work);
+ }
+
+#ifdef __cplusplus
+}
+#endif
+
Added: pkg/VariABEL/src/CastUtils.cpp
===================================================================
--- pkg/VariABEL/src/CastUtils.cpp (rev 0)
+++ pkg/VariABEL/src/CastUtils.cpp 2011-03-07 14:28:32 UTC (rev 677)
@@ -0,0 +1,207 @@
+#include <map>
+#include <string>
+#include <algorithm>
+#include <cmath>
+
+using namespace std;
+
+#include "frutil.h"
+#include "CastUtils.h"
+
+unsigned short int UNSIGNED_SHORT_INT_NAN;
+short int SHORT_INT_NAN;
+unsigned int UNSIGNED_INT_NAN;
+int INT_NAN;
+char CHAR_NAN;
+unsigned char UNSIGNED_CHAR_NAN;
+char const* parseFormats[9];
+
+int initConsts(){
+ int i;
+ sscanf("32767","%hi",&SHORT_INT_NAN);
+ sscanf("65535","%hu",&UNSIGNED_SHORT_INT_NAN);
+ sscanf("2147483647","%i",&INT_NAN);
+ sscanf("4294967295","%u",&UNSIGNED_INT_NAN);
+ sscanf("127","%i",&i); CHAR_NAN = i;
+ sscanf("255","%u",&i); UNSIGNED_CHAR_NAN = i;
+
+ parseFormats[UNSIGNED_SHORT_INT] = "%hu";
+ parseFormats[SHORT_INT] = "%hd";
+ parseFormats[UNSIGNED_INT] = "%u";
+ parseFormats[INT] = "%d";
+ parseFormats[FLOAT] = "%f";
+ parseFormats[DOUBLE] = "%lf";
+ parseFormats[SIGNED_CHAR] = "%i";
+ parseFormats[UNSIGNED_CHAR] = "%i";
+ return 0;
+}
+
+int dummy = initConsts();
+
+void parseStringToArbType(string s, int destType, void *destData, string nanString) {
+ char const *format = parseFormats[destType];
+
+ int result;
+ // no proper format specifier exists for char
+ if (destType == SIGNED_CHAR || destType == UNSIGNED_CHAR) {
+ int i;
+ result = sscanf(s.c_str(), format, &i);
+ if (nanString == s || result !=1){
+ setNan(destData, destType);
+ return;
+ } else {
+ if (destType == SIGNED_CHAR) *(char*) destData = i;
+ if (destType == UNSIGNED_CHAR) *(unsigned char*) destData = i;
+ }
+
+ } else {
+ result = sscanf(s.c_str(), format, destData);
+ if (nanString == s || result !=1){
+ setNan(destData, destType);
+ return;
+ }
+ }
+}
+
+unsigned short int dataTypeFromString(string type){
+ if (type == "UNSIGNED_SHORT_INT") return 1;
+ if (type == "SHORT_INT") return 2;
+ if (type == "UNSIGNED_INT") return 3;
+ if (type == "INT") return 4;
+ if (type == "FLOAT") return 5;
+ if (type == "DOUBLE") return 6;
+ if (type == "CHAR") return 7;
+ if (type == "UNSIGNED_CHAR") return 8;
+ return 0;
+}
+
+string dataTypeToString(int type){
+ if (type == 1) return "UNSIGNED_SHORT_INT";
+ if (type == 2) return "SHORT_INT";
+ if (type == 3) return "UNSIGNED_INT";
+ if (type == 4) return "INT";
+ if (type == 5) return "FLOAT";
+ if (type == 6) return "DOUBLE";
+ if (type == 7) return "CHAR";
+ if (type == 8) return "UNSIGNED_CHAR";
+ return 0;
+}
+
+string bufToString(short int dataType, char *data, string nanString){
+ char ret[500];
+ switch(dataType){
+ case UNSIGNED_SHORT_INT:
+ sprintf(ret, "%hu", *(unsigned short int*)data);
+ break;
+ case SHORT_INT:
+ sprintf(ret, "%hd", *(short int*)data);
+ break;
+ case UNSIGNED_INT:
+ sprintf(ret, "%u", *(unsigned int*)data);
+ break;
+ case INT:
+ sprintf(ret, "%d", *(int*)data);
+ break;
+ case FLOAT:
+ sprintf(ret, "%f", *(float*)data);
+ break;
+ case DOUBLE: // changed to "%f" from %lf [not ISO C++]
+ sprintf(ret, "%f", *(double*)data);
+ break;
+ case SIGNED_CHAR: // changed to "%f" from %lf [not ISO C++]
+ sprintf(ret, "%d", (int)*(char*)data);
+ break;
+ case UNSIGNED_CHAR: // changed to "%f" from %lf [not ISO C++]
+ sprintf(ret, "%d", (int)*(unsigned char*)data);
+ break;
+ }
+ if (checkNan(data,dataType)) {
+ return nanString;
+ }
+
+ return string(ret);
+}
+
+void setNan(unsigned short int &i){setNan(&i, UNSIGNED_SHORT_INT);}
+void setNan(short int &i){setNan(&i, SHORT_INT);}
+void setNan(unsigned int &i){setNan(&i, UNSIGNED_INT);}
+void setNan(int &i){setNan(&i, INT);}
+void setNan(float &i){setNan(&i, FLOAT);}
+void setNan(double &i){setNan(&i, DOUBLE);}
+void setNan(char &i){setNan(&i, SIGNED_CHAR);}
+void setNan(unsigned char &i){setNan(&i, UNSIGNED_CHAR);}
+
+bool checkNan(unsigned short int i){return checkNan(&i, UNSIGNED_SHORT_INT);}
+bool checkNan(short int i){return checkNan(&i, SHORT_INT);}
+bool checkNan(unsigned int i){return checkNan(&i, UNSIGNED_INT);}
+bool checkNan(int i){return checkNan(&i, INT);}
+bool checkNan(float i){return checkNan(&i, FLOAT);}
+bool checkNan(double i){return checkNan(&i, DOUBLE);}
+bool checkNan(char i){return checkNan(&i, SIGNED_CHAR);}
+bool checkNan(unsigned char i){return checkNan(&i, UNSIGNED_CHAR);}
+
+void setNan(void *data, int dataType){
+ double dZero = 0.;
+ float fZero = 0.;
+ switch (dataType) {
+ case UNSIGNED_SHORT_INT:
+ (*(unsigned short int*) data) = UNSIGNED_SHORT_INT_NAN;
+ break;
+ case SHORT_INT:
+ (*(short int*) data) = SHORT_INT_NAN;
+ break;
+ case UNSIGNED_INT:
+ (*(unsigned int*) data) = UNSIGNED_INT_NAN;
+ break;
+ case INT:
+ (*(int*) data) = INT_NAN;
+ break;
+ case FLOAT:
+ (*(float*) data) = fZero/fZero;
+ break;
+ case DOUBLE:
+ (*(double*) data) = dZero/dZero;
+ break;
+ case SIGNED_CHAR:
+ (*(char*) data) = CHAR_NAN;
+ break;
+ case UNSIGNED_CHAR:
+ (*(unsigned char*) data) = UNSIGNED_CHAR_NAN;
+ break;
+ default:
+ errorLog << "file contains data of unknown type " << dataType << endl << errorExit;
+ }
+}
+
+bool checkNan(void *data, int dataType){
+ switch (dataType) {
+ case UNSIGNED_SHORT_INT:
+ return (*(unsigned short int*) data) == UNSIGNED_SHORT_INT_NAN;
+ case SHORT_INT:
+ return (*(short int*) data) == SHORT_INT_NAN;
+ case UNSIGNED_INT:
+ return (*(unsigned int*) data) == UNSIGNED_INT_NAN;
+ case INT:
+ return (*(int*) data) == INT_NAN;
+ case FLOAT:
+ return isnan(*(float*) data);
+ case DOUBLE:
+ return isnan(*(double*) data);
+ case UNSIGNED_CHAR:
+ return (*(unsigned char*) data) == UNSIGNED_CHAR_NAN;
+ case SIGNED_CHAR:
+ return (*(char*) data) == CHAR_NAN;
+ default:
+ errorLog << "file contains data of unknown type " << dataType << endl << errorExit;
+ return false;
+ }
+}
+
+int getDataType(unsigned short int){return UNSIGNED_SHORT_INT;}
+int getDataType(short int){return SHORT_INT;}
+int getDataType(unsigned int){return UNSIGNED_INT;}
+int getDataType(int){return INT;}
+int getDataType(float){return FLOAT;}
+int getDataType(double){return DOUBLE;}
+int getDataType(char){return SIGNED_CHAR;}
+int getDataType(unsigned char){return UNSIGNED_CHAR;}
Added: pkg/VariABEL/src/CastUtils.h
===================================================================
--- pkg/VariABEL/src/CastUtils.h (rev 0)
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/genabel -r 677
More information about the Genabel-commits
mailing list