[Genabel-commits] r682 - in pkg/VariABEL: . src src/ITERlib src/VARlib
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Mar 7 16:14:48 CET 2011
Author: yurii
Date: 2011-03-07 16:14:47 +0100 (Mon, 07 Mar 2011)
New Revision: 682
Added:
pkg/VariABEL/cleanup
pkg/VariABEL/cleanup.win
pkg/VariABEL/configure
pkg/VariABEL/configure.R
pkg/VariABEL/configure.win
pkg/VariABEL/src/ITERlib/iterator.cpp
pkg/VariABEL/src/ITERlib/iterator.h
pkg/VariABEL/src/ITERlib/iterator_functions.cpp
pkg/VariABEL/src/ITERlib/iterator_functions.h
pkg/VariABEL/src/Makevars
pkg/VariABEL/src/Makevars.win
pkg/VariABEL/src/Makevars_distrib
pkg/VariABEL/src/VARlib/const.h
pkg/VariABEL/src/VARlib/constants.h
pkg/VariABEL/src/VARlib/gtps_container.cpp
pkg/VariABEL/src/VARlib/gtps_container.h
pkg/VariABEL/src/VARlib/inverse_variance_metaanalysis.cpp
pkg/VariABEL/src/VARlib/inverse_variance_metaanalysis.h
pkg/VariABEL/src/VARlib/linear_regression.cpp
pkg/VariABEL/src/VARlib/linear_regression.h
pkg/VariABEL/src/VARlib/supplementary_functions.cpp
pkg/VariABEL/src/VARlib/supplementary_functions.h
pkg/VariABEL/src/VARlib/var_homogeneity_test_C.cpp
pkg/VariABEL/src/VARlib/var_homogeneity_tests.cpp
pkg/VariABEL/src/VARlib/var_homogeneity_tests.h
pkg/VariABEL/src/VARlib/var_meta_gwaa_C.cpp
Removed:
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
Modified:
pkg/VariABEL/NAMESPACE
Log:
re-structuring VariABEL
Modified: pkg/VariABEL/NAMESPACE
===================================================================
--- pkg/VariABEL/NAMESPACE 2011-03-07 15:08:46 UTC (rev 681)
+++ pkg/VariABEL/NAMESPACE 2011-03-07 15:14:47 UTC (rev 682)
@@ -3,7 +3,7 @@
export(
var.meta.gwaa,
- var.test.gwaa,
- test_databel
+ var.test.gwaa#,
+ #test_databel
)
Added: pkg/VariABEL/cleanup
===================================================================
--- pkg/VariABEL/cleanup (rev 0)
+++ pkg/VariABEL/cleanup 2011-03-07 15:14:47 UTC (rev 682)
@@ -0,0 +1,3 @@
+rm -f configure.Rout
+rm -rf .RData R/.RData
+rm -f src/*.o
Property changes on: pkg/VariABEL/cleanup
___________________________________________________________________
Added: svn:executable
+ *
Added: pkg/VariABEL/cleanup.win
===================================================================
--- pkg/VariABEL/cleanup.win (rev 0)
+++ pkg/VariABEL/cleanup.win 2011-03-07 15:14:47 UTC (rev 682)
@@ -0,0 +1,3 @@
+rm -f configure.Rout
+rm -rf .RData R/.RData
+rm -f src/*.o
Property changes on: pkg/VariABEL/cleanup.win
___________________________________________________________________
Added: svn:executable
+ *
Added: pkg/VariABEL/configure
===================================================================
--- pkg/VariABEL/configure (rev 0)
+++ pkg/VariABEL/configure 2011-03-07 15:14:47 UTC (rev 682)
@@ -0,0 +1 @@
+${R_HOME}/bin/R CMD BATCH configure.R
Property changes on: pkg/VariABEL/configure
___________________________________________________________________
Added: svn:executable
+ *
Added: pkg/VariABEL/configure.R
===================================================================
--- pkg/VariABEL/configure.R (rev 0)
+++ pkg/VariABEL/configure.R 2011-03-07 15:14:47 UTC (rev 682)
@@ -0,0 +1,19 @@
+#source("generate_documentation.R")
+
+unlink("src/*.cpp")
+unlink("src/*.c")
+unlink("src/*.h")
+unlink("src/*.o")
+unlink("src/*.so")
+unlink("src/*.dll")
+
+flstFV <- list.files("src/fvlib/")
+flstVAR <- list.files("src/VARlib/")
+flstDA <- list.files("src/DAlib/")
+flstITER <- list.files("src/ITERlib/")
+frm <- paste("src/fvlib/",flstFV,sep="")
+frm <- c(frm,paste("src/VARlib/",flstVAR,sep=""))
+frm <- c(frm,paste("src/DAlib/",flstDA,sep=""))
+frm <- c(frm,paste("src/ITERlib/",flstITER,sep=""))
+#print(frm)
+file.copy(from=frm,to="src", overwrite = TRUE)
Added: pkg/VariABEL/configure.win
===================================================================
--- pkg/VariABEL/configure.win (rev 0)
+++ pkg/VariABEL/configure.win 2011-03-07 15:14:47 UTC (rev 682)
@@ -0,0 +1 @@
+${R_HOME}/bin/R CMD BATCH configure.R
Property changes on: pkg/VariABEL/configure.win
___________________________________________________________________
Added: svn:executable
+ *
Deleted: pkg/VariABEL/src/AbstractMatrix.cpp
===================================================================
--- pkg/VariABEL/src/AbstractMatrix.cpp 2011-03-07 15:08:46 UTC (rev 681)
+++ pkg/VariABEL/src/AbstractMatrix.cpp 2011-03-07 15:14:47 UTC (rev 682)
@@ -1,20 +0,0 @@
-#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);
-}
-
-
-
Deleted: pkg/VariABEL/src/AbstractMatrix.h
===================================================================
--- pkg/VariABEL/src/AbstractMatrix.h 2011-03-07 15:08:46 UTC (rev 681)
+++ pkg/VariABEL/src/AbstractMatrix.h 2011-03-07 15:14:47 UTC (rev 682)
@@ -1,130 +0,0 @@
-#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
-
-
Deleted: pkg/VariABEL/src/AbstractMatrix_R.cpp
===================================================================
--- pkg/VariABEL/src/AbstractMatrix_R.cpp 2011-03-07 15:08:46 UTC (rev 681)
+++ pkg/VariABEL/src/AbstractMatrix_R.cpp 2011-03-07 15:14:47 UTC (rev 682)
@@ -1,744 +0,0 @@
-#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
-
Deleted: pkg/VariABEL/src/CastUtils.cpp
===================================================================
--- pkg/VariABEL/src/CastUtils.cpp 2011-03-07 15:08:46 UTC (rev 681)
+++ pkg/VariABEL/src/CastUtils.cpp 2011-03-07 15:14:47 UTC (rev 682)
@@ -1,207 +0,0 @@
-#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);}
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/genabel -r 682
More information about the Genabel-commits
mailing list