RGLab/cytolib#3

RGLab · Jan 12, 2018 · 223061e · 223061e
1 parent d906030
commit 223061e
Show file tree

Hide file tree

Showing 11 changed files with 81 additions and 61 deletions.
diff --git a/R/AllClasses.R b/R/AllClasses.R
@@ -1,7 +1,7 @@
 #' @include AllGenerics.R
 NULL
 
-#' @useDynLib flowWorkspace
+#' @useDynLib flowWorkspace .registration = TRUE
 NULL
 
 #' @name flowWorkspace-package
@@ -195,8 +195,15 @@ setGeneric("GatingSet",function(x,y,...)standardGeneric("GatingSet"))
 #' @rdname GatingSet-methods
 #' @aliases GatingSet
 #' @export 
-setMethod("GatingSet",c("character","character"),function(x,y, guids, includeGates=FALSE, sampNloc="keyword",xmlParserOption, wsType){
-
+setMethod("GatingSet",c("character","character"),function(x,y, guids
+                                                        , includeGates=FALSE
+                                                        , sampNloc="keyword"
+                                                          ,xmlParserOption
+                                                          , wsType
+                                                          , loglevel
+                                                          , throw_on_error){
+      valid_levels <- c("none", "GatingSet", "GatingHierarchy", "Population", "Gate")
+      loglevel <- match.arg(loglevel, valid_levels)
       xmlFileName<-x
       sampleIDs<-y
 #			browser()
@@ -212,7 +219,16 @@ setMethod("GatingSet",c("character","character"),function(x,y, guids, includeGat
       if(!file.exists(xmlFileName))
         stop(xmlFileName," not found!")
       Object<-new("GatingSet")
-      Object@pointer<-.cpp_parseWorkspace(xmlFileName,sampleIDs,guids,includeGates,as.integer(sampNloc),as.integer(xmlParserOption),as.integer(wsType))
+      Object@pointer<-.cpp_parseWorkspace(xmlFileName
+                                          ,sampleIDs
+                                          ,guids
+                                          ,includeGates
+                                          ,as.integer(sampNloc)
+                                          ,as.integer(xmlParserOption)
+                                           ,as.integer(wsType)
+                                            , loglevel - 1
+                                            , throw_on_error
+                                        )
       Object@guid <- .uuid_gen()
       Object@flag <- FALSE
 

diff --git a/R/GatingSet_Methods.R b/R/GatingSet_Methods.R
@@ -1985,8 +1985,8 @@ setMethod("setNode"
 #' @return a character that represents the internal log level
 #' @rdname loglevel
 #' @export
-getLoglevel <- function(){
-  level <- .cpp_getLogLevel()
+getLoglevel <- function(gs){
+  level <- .cpp_getLogLevel(gs@pointer)
   c("none", "GatingSet", "GatingHierarchy", "Population", "Gate")[level + 1]
 }
 
@@ -2002,10 +2002,10 @@ getLoglevel <- function(){
 #'
 #' @rdname loglevel
 #' @export
-setLoglevel <- function(level = "none"){
+setLoglevel <- function(gs, level = "none"){
   valid_levels <- c("none", "GatingSet", "GatingHierarchy", "Population", "Gate")
   level <- match.arg(level, valid_levels)
-  .cpp_setLogLevel( as.integer(match(level, valid_levels) - 1))
+  .cpp_setLogLevel(gs@pointer, as.integer(match(level, valid_levels) - 1))
   level
 }
 

diff --git a/R/RcppExports.R b/R/RcppExports.R
@@ -164,8 +164,8 @@
     invisible(.Call('_flowWorkspace_setNodeFlag', PACKAGE = 'flowWorkspace', gs, sampleName, gatePath, hidden))
 }
 
-.cpp_parseWorkspace <- function(fileName, sampleIDs, sampleNames, isParseGate, sampNloc, xmlParserOption, wsType) {
-    .Call('_flowWorkspace_parseWorkspace', PACKAGE = 'flowWorkspace', fileName, sampleIDs, sampleNames, isParseGate, sampNloc, xmlParserOption, wsType)
+.cpp_parseWorkspace <- function(fileName, sampleIDs, sampleNames, isParseGate, sampNloc, xmlParserOption, wsType, loglevel = 0L, throw_on_error = TRUE) {
+    .Call('_flowWorkspace_parseWorkspace', PACKAGE = 'flowWorkspace', fileName, sampleIDs, sampleNames, isParseGate, sampNloc, xmlParserOption, wsType, loglevel, throw_on_error)
 }
 
 .cpp_getSamples <- function(gsPtr) {
@@ -200,16 +200,12 @@
     invisible(.Call('_flowWorkspace_setSample', PACKAGE = 'flowWorkspace', gs, oldName, newName))
 }
 
-.cpp_getLogLevel <- function() {
-    .Call('_flowWorkspace_getLogLevel', PACKAGE = 'flowWorkspace')
+.cpp_getLogLevel <- function(gs) {
+    .Call('_flowWorkspace_getLogLevel', PACKAGE = 'flowWorkspace', gs)
 }
 
-.cpp_setLogLevel <- function(loglevel) {
-    invisible(.Call('_flowWorkspace_setLogLevel', PACKAGE = 'flowWorkspace', loglevel))
-}
-
-.cpp_togleErrorFlag <- function() {
-    invisible(.Call('_flowWorkspace_toggleErrorFlag', PACKAGE = 'flowWorkspace'))
+.cpp_setLogLevel <- function(gs, loglevel) {
+    invisible(.Call('_flowWorkspace_setLogLevel', PACKAGE = 'flowWorkspace', gs, loglevel))
 }
 
 #' set the event counts for a given node

diff --git a/R/flowJoWorkspace_Methods.R b/R/flowJoWorkspace_Methods.R
@@ -125,7 +125,9 @@ setMethod("closeWorkspace","flowJoWorkspace",function(workspace){
 #'                                                          to uniquely identify samples. Default is '$TOT' (total number of cells) and more keywords can be added to make this GUID.
 #'          \item keywords \code{character} vector specifying the keywords to be extracted as pData of GatingSet
 #'          \item keywords.source \code{character} the place where the keywords are extracted from, can be either "XML" or "FCS"
-#'          \item keyword.ignore.case a \code{logical} flag indicates whether the keywords matching needs to be case sensitive.    
+#'          \item keyword.ignore.case a \code{logical} flag indicates whether the keywords matching needs to be case sensitive.
+#'          \item loglevel control the level of verbose message. Can be "none", "GatingSet", "GatingHierarchy", "Population" or "Gate". Default is "none"
+#'          \itme throw_on_error When set to FALSE, it allows the parser to skip the gates that can't be parsed correctly to generate a partially parsed gating tree. (Mainly for troubleshooting)    
 #'      	\item ...: Additional arguments to be passed to \link{read.ncdfFlowSet} or \link{read.flowSet}.
 #'      	}
 #' @details
@@ -499,7 +501,10 @@ setMethod("parseWorkspace",signature("flowJoWorkspace"),function(obj, ...){
   return(pd)
 }
 .parseWorkspace <- function(xmlFileName, execute, isNcdf = TRUE, includeGates = TRUE
-                            ,sampNloc="keyword",xmlParserOption, wsType, ws, pd, ...){
+                            ,sampNloc="keyword",xmlParserOption, wsType, ws, pd
+                            , loglevel = "none"
+                            , throw_on_error = TRUE
+                            , ...){
 
 
 #	message("calling c++ parser...")
@@ -512,6 +517,8 @@ setMethod("parseWorkspace",signature("flowJoWorkspace"),function(obj, ...){
       , sampNloc = sampNloc
       , xmlParserOption = xmlParserOption
       , wsType = wsType
+      , loglevel = loglevel
+      , throw_on_error = throw_on_error
   )
 
 #	message("c++ parsing done!")

diff --git a/inst/cppTest/unitTest/gatingSet_test.cpp b/inst/cppTest/unitTest/gatingSet_test.cpp
@@ -279,6 +279,9 @@ void parser_test(testCase & myTest){
 			if(!isLoadArchive)
 			{
 				workspace * ws = openWorkspace(myTest.filename, myTest.sampNloc,myTest.xmlParserOption, wsType);
+				ws->set_loglevel(myTest.g_loglevel);
+				ws->set_throw_on_error(true);
+
 				gs.reset(ws->ws2gs(sampleIDs,isParseGate,sampleNames));
 				delete ws;
 			}

diff --git a/inst/cppTest/unitTest/testSuite.cpp b/inst/cppTest/unitTest/testSuite.cpp
@@ -5,8 +5,6 @@
 
 #include "test_header.hpp"
 float gTol = 0.05;
-bool my_throw_on_error = true;
-unsigned short g_loglevel = 0;
 //unsigned short myTestPolymorphism(){
 //	gate * g= NULL;
 //
@@ -90,7 +88,7 @@ struct parseWorkspaceFixture{
 		myTest.isSaveArchive = it==arg_map.end()?false:boost::lexical_cast<bool>(it->second);
 
 		it = arg_map.find("g_loglevel");
-		g_loglevel = it==arg_map.end()?false:boost::lexical_cast<unsigned>(it->second);
+		myTest.g_loglevel = it==arg_map.end()?false:boost::lexical_cast<unsigned>(it->second);
 
 	};
 

diff --git a/inst/cppTest/unitTest/test_header.hpp b/inst/cppTest/unitTest/test_header.hpp
@@ -42,6 +42,7 @@ struct testCase{
 	bool archiveType;// boost or google
 	map<string,float> gains;
 	vector<VertexID> skipPops;
+	unsigned short g_loglevel;
 //	vector<double> times;//global variable to collect run time
 
 } ;

diff --git a/inst/include/flowWorkspace/openWorkspace.hpp b/inst/include/flowWorkspace/openWorkspace.hpp
@@ -55,11 +55,10 @@ inline workspace * openWorkspace(string sFileName,unsigned short sampNloc,int xm
 		 }
 
 
-
 		 wsPtr->nodePath.sampNloc=sampNloc;
 
-		 if(g_loglevel>=GATING_SET_LEVEL)
-			 COUT<<"internal gating set created from "<<sFileName<<endl;
+//		 if(g_loglevel>=GATING_SET_LEVEL)
+//			 COUT<<"internal gating set created from "<<sFileName<<endl;
 
 		 wsPtr->parseVersionList();
 		 return wsPtr;

diff --git a/inst/include/flowWorkspace/workspace.hpp b/inst/include/flowWorkspace/workspace.hpp
@@ -62,14 +62,18 @@ struct xpath{
 
 
 class workspace{
+protected:
+	unsigned short g_loglevel;// debug print is turned off by default
+	bool my_throw_on_error;//can be toggle off to get a partially parsed gating tree for debugging purpose
+
 public:
 	 xpath nodePath;
 //protected:
 
 	 xmlDoc * doc;
 
 public:
-	 workspace(){doc=NULL;};
+	 workspace():g_loglevel(NO_LOG),my_throw_on_error(true){doc=NULL;};
 	 virtual ~workspace()
 	 {
 			if(doc!=NULL)
@@ -86,6 +90,8 @@ class workspace{
 					COUT<<"xml freed!"<<endl;
 			}
 	 }
+	 void set_loglevel(unsigned short _g_loglevel){g_loglevel = _g_loglevel;};
+	 void set_throw_on_error(bool flag){my_throw_on_error = flag;};
 	 virtual string xPathSample(string sampleID)=0;
 	 virtual PARAM_VEC getTransFlag(wsSampleNode sampleNode)=0;
 	 virtual trans_local getTransformation(wsRootNode,const compensation &,PARAM_VEC &,trans_global_vec *, biexpTrans * _globalBiExpTrans, linTrans * _globalLinTrans, bool prefixed)=0;
@@ -240,6 +246,7 @@ class workspace{
 	 GatingSet * ws2gs(vector<string> sampleIDs,bool isParseGate, StringVec sampleNames)
 	 {
 	 	GatingSet * gs=new GatingSet();
+	 	gs->set_loglevel(g_loglevel);
 	 	 /*
 	 	  * parsing global calibration tables
 	 	  */
@@ -265,6 +272,7 @@ class workspace{
 	 		wsSampleNode curSampleNode=getSample(sampleID);
 
 	 		GatingHierarchy & gh = gs->addGatingHierarchy(sampleName);
+	 		gh.set_loglevel(g_loglevel);
 	 		ws2gh(gh,curSampleNode,isParseGate,&gTrans,gs->get_globalBiExpTrans(),gs->get_globalLinTrans());
 
 	 		if(g_loglevel>=GATING_HIERARCHY_LEVEL)

diff --git a/src/R_GatingSet.cpp b/src/R_GatingSet.cpp
@@ -10,8 +10,8 @@
 #include "flowWorkspace/openWorkspace.hpp"
 #include <Rcpp.h>
 using namespace Rcpp;
-bool my_throw_on_error = true;
-unsigned short g_loglevel = 0;
+//;
+//;
 GatingSet * getGsPtr(SEXP _gsPtr){
 
 	if(R_ExternalPtrAddr(_gsPtr)==0)
@@ -33,9 +33,12 @@ GatingSet * getGsPtr(SEXP _gsPtr){
 XPtr<GatingSet> parseWorkspace(string fileName,StringVec sampleIDs
                             ,StringVec sampleNames,bool isParseGate
                             ,unsigned short sampNloc,int xmlParserOption
-                            , unsigned short wsType) 
+                            , unsigned short wsType
+							, unsigned short loglevel = 0, bool throw_on_error = true)
 {
 		workspace * ws = openWorkspace(fileName, sampNloc,xmlParserOption, wsType);
+		ws->set_loglevel(loglevel);
+		ws->set_throw_on_error(throw_on_error);
 		GatingSet * gs = ws->ws2gs(sampleIDs,isParseGate,sampleNames);
 		delete ws;
 		return XPtr<GatingSet>(gs);
@@ -142,20 +145,15 @@ void setSample(XPtr<GatingSet> gs,string oldName, string newName) {
 }
 
 //[[Rcpp::export(name=".cpp_getLogLevel")]]
-unsigned short getLogLevel() {
+unsigned short getLogLevel(XPtr<GatingSet> gs) {
 
-		return(g_loglevel);
+		return(gs->get_loglevel());
 
 }
 
 //[[Rcpp::export(name=".cpp_setLogLevel")]]
-void setLogLevel(unsigned short loglevel) {
+void setLogLevel(XPtr<GatingSet> gs, unsigned short loglevel) {
 
-		g_loglevel = loglevel;
+		gs->set_loglevel(loglevel);
 
 }
-
-//[[Rcpp::export(name=".cpp_togleErrorFlag")]]
-void toggleErrorFlag(){
-	my_throw_on_error = !my_throw_on_error;
-}
diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp
@@ -400,8 +400,8 @@ BEGIN_RCPP
 END_RCPP
 }
 // parseWorkspace
-XPtr<GatingSet> parseWorkspace(string fileName, StringVec sampleIDs, StringVec sampleNames, bool isParseGate, unsigned short sampNloc, int xmlParserOption, unsigned short wsType);
-RcppExport SEXP _flowWorkspace_parseWorkspace(SEXP fileNameSEXP, SEXP sampleIDsSEXP, SEXP sampleNamesSEXP, SEXP isParseGateSEXP, SEXP sampNlocSEXP, SEXP xmlParserOptionSEXP, SEXP wsTypeSEXP) {
+XPtr<GatingSet> parseWorkspace(string fileName, StringVec sampleIDs, StringVec sampleNames, bool isParseGate, unsigned short sampNloc, int xmlParserOption, unsigned short wsType, unsigned short loglevel, bool throw_on_error);
+RcppExport SEXP _flowWorkspace_parseWorkspace(SEXP fileNameSEXP, SEXP sampleIDsSEXP, SEXP sampleNamesSEXP, SEXP isParseGateSEXP, SEXP sampNlocSEXP, SEXP xmlParserOptionSEXP, SEXP wsTypeSEXP, SEXP loglevelSEXP, SEXP throw_on_errorSEXP) {
 BEGIN_RCPP
     Rcpp::RObject rcpp_result_gen;
     Rcpp::RNGScope rcpp_rngScope_gen;
@@ -412,7 +412,9 @@ BEGIN_RCPP
     Rcpp::traits::input_parameter< unsigned short >::type sampNloc(sampNlocSEXP);
     Rcpp::traits::input_parameter< int >::type xmlParserOption(xmlParserOptionSEXP);
     Rcpp::traits::input_parameter< unsigned short >::type wsType(wsTypeSEXP);
-    rcpp_result_gen = Rcpp::wrap(parseWorkspace(fileName, sampleIDs, sampleNames, isParseGate, sampNloc, xmlParserOption, wsType));
+    Rcpp::traits::input_parameter< unsigned short >::type loglevel(loglevelSEXP);
+    Rcpp::traits::input_parameter< bool >::type throw_on_error(throw_on_errorSEXP);
+    rcpp_result_gen = Rcpp::wrap(parseWorkspace(fileName, sampleIDs, sampleNames, isParseGate, sampNloc, xmlParserOption, wsType, loglevel, throw_on_error));
     return rcpp_result_gen;
 END_RCPP
 }
@@ -510,31 +512,24 @@ BEGIN_RCPP
 END_RCPP
 }
 // getLogLevel
-unsigned short getLogLevel();
-RcppExport SEXP _flowWorkspace_getLogLevel() {
+unsigned short getLogLevel(XPtr<GatingSet> gs);
+RcppExport SEXP _flowWorkspace_getLogLevel(SEXP gsSEXP) {
 BEGIN_RCPP
     Rcpp::RObject rcpp_result_gen;
     Rcpp::RNGScope rcpp_rngScope_gen;
-    rcpp_result_gen = Rcpp::wrap(getLogLevel());
+    Rcpp::traits::input_parameter< XPtr<GatingSet> >::type gs(gsSEXP);
+    rcpp_result_gen = Rcpp::wrap(getLogLevel(gs));
     return rcpp_result_gen;
 END_RCPP
 }
 // setLogLevel
-void setLogLevel(unsigned short loglevel);
-RcppExport SEXP _flowWorkspace_setLogLevel(SEXP loglevelSEXP) {
+void setLogLevel(XPtr<GatingSet> gs, unsigned short loglevel);
+RcppExport SEXP _flowWorkspace_setLogLevel(SEXP gsSEXP, SEXP loglevelSEXP) {
 BEGIN_RCPP
     Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< XPtr<GatingSet> >::type gs(gsSEXP);
     Rcpp::traits::input_parameter< unsigned short >::type loglevel(loglevelSEXP);
-    setLogLevel(loglevel);
-    return R_NilValue;
-END_RCPP
-}
-// toggleErrorFlag
-void toggleErrorFlag();
-RcppExport SEXP _flowWorkspace_toggleErrorFlag() {
-BEGIN_RCPP
-    Rcpp::RNGScope rcpp_rngScope_gen;
-    toggleErrorFlag();
+    setLogLevel(gs, loglevel);
     return R_NilValue;
 END_RCPP
 }
@@ -582,7 +577,7 @@ static const R_CallMethodDef CallEntries[] = {
     {"_flowWorkspace_moveNode", (DL_FUNC) &_flowWorkspace_moveNode, 4},
     {"_flowWorkspace_setNodeName", (DL_FUNC) &_flowWorkspace_setNodeName, 4},
     {"_flowWorkspace_setNodeFlag", (DL_FUNC) &_flowWorkspace_setNodeFlag, 4},
-    {"_flowWorkspace_parseWorkspace", (DL_FUNC) &_flowWorkspace_parseWorkspace, 7},
+    {"_flowWorkspace_parseWorkspace", (DL_FUNC) &_flowWorkspace_parseWorkspace, 9},
     {"_flowWorkspace_getSamples", (DL_FUNC) &_flowWorkspace_getSamples, 1},
     {"_flowWorkspace_NewGatingSet", (DL_FUNC) &_flowWorkspace_NewGatingSet, 3},
     {"_flowWorkspace_NewGatingSet_rootOnly", (DL_FUNC) &_flowWorkspace_NewGatingSet_rootOnly, 1},
@@ -591,9 +586,8 @@ static const R_CallMethodDef CallEntries[] = {
     {"_flowWorkspace_CloneGatingSet", (DL_FUNC) &_flowWorkspace_CloneGatingSet, 2},
     {"_flowWorkspace_combineGatingSet", (DL_FUNC) &_flowWorkspace_combineGatingSet, 2},
     {"_flowWorkspace_setSample", (DL_FUNC) &_flowWorkspace_setSample, 3},
-    {"_flowWorkspace_getLogLevel", (DL_FUNC) &_flowWorkspace_getLogLevel, 0},
-    {"_flowWorkspace_setLogLevel", (DL_FUNC) &_flowWorkspace_setLogLevel, 1},
-    {"_flowWorkspace_toggleErrorFlag", (DL_FUNC) &_flowWorkspace_toggleErrorFlag, 0},
+    {"_flowWorkspace_getLogLevel", (DL_FUNC) &_flowWorkspace_getLogLevel, 1},
+    {"_flowWorkspace_setLogLevel", (DL_FUNC) &_flowWorkspace_setLogLevel, 2},
     {"_flowWorkspace_setCounts", (DL_FUNC) &_flowWorkspace_setCounts, 4},
     {NULL, NULL, 0}
 };