[Caic-commits] r71 - in pkg: . R

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

Author: davidorme
Date: 2008-10-02 22:17:31 +0200 (Thu, 02 Oct 2008)
New Revision: 71

Modified:
   pkg/DESCRIPTION
   pkg/R/brunch.R
   pkg/R/crunch.R
Log:
fix of brunch and crunch fouled up the data block used in the contrasts by including the tip names - tip names for dropping incomplete tip now handled separately

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2008-10-02 20:04:19 UTC (rev 70)
+++ pkg/DESCRIPTION	2008-10-02 20:17:31 UTC (rev 71)
@@ -1,7 +1,7 @@
 Package: CAIC
 Type: Package
 Title: Comparative Analyses using Independent Contrasts
-Version: 1.0.4-66
+Version: 1.0.4-71
 Date: 2008-10-01
 Author: David Orme, Rob Freckleton, Gavin Thomas
 Maintainer: David Orme <d.orme at imperial.ac.uk>

Modified: pkg/R/brunch.R
===================================================================
--- pkg/R/brunch.R	2008-10-02 20:04:19 UTC (rev 70)
+++ pkg/R/brunch.R	2008-10-02 20:17:31 UTC (rev 71)
@@ -90,9 +90,11 @@
         # Size of conjunction of tree and dataset
         unionData <- dim(data)[1] 
         
-        # reduce to just the variables used in the formula and the names column
-        data <- subset(data, select=c(names.col, all.vars(formula)))
-        
+        # reduce to just the variables used in the formula so they can all be treated as numeric 
+        # but hang on to tip labels for subsetting the phylogeny down to complete tips
+        tipLabs <- subset(data, select=names.col, drop=TRUE)
+        data <- subset(data, select=all.vars(formula))
+          
     # CALCULATE MODEL 
     # GET THE MODEL MATRIX and Model Response
         
@@ -132,8 +134,6 @@
         if(any( varLevels > 2 & ! varIsOrdered )) stop("Unordered non-binary factors included in model formula.")
         
         # refit the model frame with numericized data
-        #data <- as.data.frame(lapply(data, function(x) as.numeric(as.factor(x))))
-        data$tip <- as.factor(data$tip)
         data <- as.data.frame(lapply(data, as.numeric))
         mf <- model.frame(formula, data, na.action=na.pass)
 
@@ -194,7 +194,7 @@
         
         # get the node depth using the tree for which we have complete data
         # and then match those nodes up against the analysis tree
-        tipsWithNAdata <- data[,names.col][! complete.cases(mf)]
+        tipsWithNAdata <- tipLabs[! complete.cases(mf)]
         if(length(tipsWithNAdata) > 0){
         	compPhy <- drop.tip(analysisPhy, tipsWithNAdata) 
     	}	else { compPhy <- analysisPhy }

Modified: pkg/R/crunch.R
===================================================================
--- pkg/R/crunch.R	2008-10-02 20:04:19 UTC (rev 70)
+++ pkg/R/crunch.R	2008-10-02 20:17:31 UTC (rev 71)
@@ -100,8 +100,10 @@
         # Size of conjunction of tree and dataset
         unionData <- dim(data)[1] 
 
-        # reduce to just the variables used in the formula and the names column
-        data <- subset(data, select=c(names.col, all.vars(formula)))
+        # reduce to just the variables used in the formula so they can all be treated as numeric 
+        # but hang on to tip labels for subsetting the phylogeny down to complete tips
+        tipLabs <- subset(data, select=names.col, drop=TRUE)
+        data <- subset(data, select=all.vars(formula))
         
     # HANDLE CATEGORICAL VARIABLES:
         # find the factors - (number of levels > 0)
@@ -185,7 +187,7 @@
         
         # get the node depth using the tree for which we have complete data
         # and then match those nodes up against the analysis tree
-        tipsWithNAdata <- data[,names.col][! complete.cases(mf)]
+        tipsWithNAdata <- tipLabs[! complete.cases(mf)]
         if(length(tipsWithNAdata) > 0){
         	compPhy <- drop.tip(analysisPhy, tipsWithNAdata) 
     	}	else { compPhy <- analysisPhy }