[Phylobase-commits] r756 - in pkg: R src

[noreply at r-forge.r-project.org]

Author: francois
Date: 2010-03-13 00:59:02 +0100 (Sat, 13 Mar 2010)
New Revision: 756

Modified:
   pkg/R/readNexus.R
   pkg/src/NCLInterface.cpp
Log:
allows importation of multiple matrices from a nexus file, fixes importation of continuous characters, fixes bug in case of empty characters while using option type='data', ReadCharsWithNCL now also returns the datatype

Modified: pkg/R/readNexus.R
===================================================================
--- pkg/R/readNexus.R	2010-03-12 23:54:43 UTC (rev 755)
+++ pkg/R/readNexus.R	2010-03-12 23:59:02 UTC (rev 756)
@@ -40,31 +40,61 @@
         }
         incharsstring <- .Call("ReadCharsWithNCL", params,
                                PACKAGE="phylobase")
-        ## Remove empty labels for factors
-        incharsstring$charstring <- gsub("\\\"\\\"", "", incharsstring$charstring)
-        incharsstring$charstring <- gsub(",+)", ")", incharsstring$charstring)
+        if (length(incharsstring) > 0) {
+            incharsstring <- unlist(strsplit(incharsstring$charstring, "\\|"))
+            incharsstring <- incharsstring[nzchar(incharsstring)]
 
-        ## For now, we can't deal with polymorphic characters and their labels
-        if (length(grep("\\{", incharsstring$charstring)) > 0 &&
-            return.labels) {
-            stop("At this stage, it's not possible to use the combination:",
-                 "return.labels=TRUE for datasets that contain polymorphic",
-                 "characters.")
-        }
+            iDtType <- seq(from=1, to=length(incharsstring), by=2)
+            iCharStrg <- seq(from=2, to=length(incharsstring), by=2)
 
-        ## Convert the string to data frame
-        tipdata <- eval(parse(text=incharsstring))
+            datatype <- incharsstring[iDtType]
+            charString <- incharsstring[iCharStrg]
 
-        ## if levels.uniform=TRUE apply the same levels to all characters
-        if (levels.uniform && length(tipdata) > 0) {
-            allLevels <- character(0)
-            for (i in 1:ncol(tipdata)) {
-                allLevels <- union(allLevels, levels(tipdata[,i]))
+            tipdata <- list()
+            for (i in 1:length(charString)) {
+                if (datatype[i] == "Standard") {
+                    ## Remove empty labels for factors
+                    charString[i] <- gsub("\\\"\\\"", "", charString[i])
+                    charString[i] <- gsub(",+)", ")", charString[i])
+
+                    ## For now, we can't deal with polymorphic characters and their labels
+                    if (length(grep("\\{", charString[i])) > 0 &&
+                        return.labels) {
+                        stop("At this stage, it's not possible to use the combination: ",
+                             "return.labels=TRUE for datasets that contain polymorphic ",
+                             "characters.")
+                    }
+
+                    ## Convert the string to data frame
+                    tipdata[[i]] <- eval(parse(text=charString[i]))
+
+                    ## if levels.uniform=TRUE apply the same levels to all characters
+                    if (levels.uniform && length(tipdata[[i]]) > 0) {
+                        allLevels <- character(0)
+                        for (j in 1:ncol(tipdata[[i]])) {
+                            allLevels <- union(allLevels, levels(tipdata[[i]][,j]))
+                        }
+                        for (j in 1:ncol(tipdata[[i]])) {
+                            levels(tipdata[[i]][,j]) <- allLevels
+                        }
+                    }
+                }
+                else {
+                    ## Just convert string to data frame for other datatype
+                    tipdata[[i]] <- eval(parse(text=charString[i]))
+                }
             }
-            for (i in 1:ncol(tipdata)) {
-                levels(tipdata[,i]) <- allLevels
+            finalTipdata <- tipdata[[1]]
+            if (length(tipdata) > 1) {
+                for(td in tipdata) {
+                    finalTipdata <- cbind(finalTipdata, td)
+                }
             }
+            tipdata <- finalTipdata
         }
+        else {
+            tipdata <- NULL
+        }
     }
     if (type == "all" || type == "tree") {
         trees <- c("Failure");
@@ -78,6 +108,7 @@
         ## Finally ready to make the call...
         intreesstring <- .Call("ReadTreesWithNCL", params,
                                PACKAGE="phylobase")
+        ## Display the string returned by NCL if quiet=FALSE
         if(!quiet) print(intreesstring)
         intreesphylolist <- read.nexustreestring(intreesstring)
         if (length(intreesphylolist)>1 && !simplify) {
@@ -120,7 +151,7 @@
             }
         }
     }
-    if (type == "tree" || length(tipdata) == 0 ) {
+    if (type == "tree" || (type == "all" && length(tipdata) == 0 )) {
         output <- trees
     }
     else {

Modified: pkg/src/NCLInterface.cpp
===================================================================
--- pkg/src/NCLInterface.cpp	2010-03-12 23:54:43 UTC (rev 755)
+++ pkg/src/NCLInterface.cpp	2010-03-12 23:59:02 UTC (rev 756)
@@ -58,6 +58,9 @@
 
 	if (!characters.IsEmpty())
 		{
+		nexuscharacters+="|";
+		nexuscharacters+=characters.GetNameOfDatatype(characters.GetDataType());
+		nexuscharacters+="|";
 		//characters.Report(cerr);
 		if (1==characters.GetDataType()) { //standard datatype
 		//if((characters.GetDatatypeName())=="standard") {
@@ -341,7 +344,7 @@
 			}
 			nexuscharacters+="), stringsAsFactors=FALSE)";
 		}
-		else if (6==characters.GetDataType()) { //continuousnexuscharacters+="data.frame(";
+		else if ("Continuous"==characters.GetNameOfDatatype(characters.GetDataType())) { //(6==characters.GetDataType()) { //continuousnexuscharacters+="data.frame(";
 			nexuscharacters+="data.frame(";
 
 			if (allchar) {
@@ -397,7 +400,9 @@
 			//PrintMessage();
 		}
 		else {
-			std::string message="Error: character matrix loaded, but does not match any category (dna, standard, etc.)";
+			std::string message="Matrix loaded but datatype: ";
+			message+=characters.GetNameOfDatatype(characters.GetDataType());
+			message+=" is not supported (yet)"; //"Error: character matrix loaded, but does not match any category (dna, standard, etc.)";
 			errorMessage(message);
 		}
 		nexuscharacters=RemoveUnderscoresAndSpaces(nexuscharacters);