[Ecopd-commits] r58 - branches/single-tree/R

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

Author: regetz
Date: 2009-11-09 19:06:02 +0100 (Mon, 09 Nov 2009)
New Revision: 58

Modified:
   branches/single-tree/R/utilities.R
Log:
updated abundance getter/setter to work with new phylo4com class


Modified: branches/single-tree/R/utilities.R
===================================================================
--- branches/single-tree/R/utilities.R	2009-11-04 19:45:30 UTC (rev 57)
+++ branches/single-tree/R/utilities.R	2009-11-09 18:06:02 UTC (rev 58)
@@ -45,16 +45,28 @@
 }
 
 # abundance extractor
-abundance <- function(phy) {
-  abund <- tipData(phy)$abundance
-  if (is.null(abund)) abund <- rep(NA_real_, nTips(phy))
-  names(abund) <- row.names(tipData(phy))
-  return(abund)
+abundance <- function(phy, comm) {
+  communities <- names(phy at metadata$comms)
+  if (missing(comm)) {
+    return(tipData(phy)[communities])
+  }
+  doNotExist <- !comm %in% communities
+  if (any(doNotExist)) {
+    stop("one or more communities not found in phy: ",
+      paste(comm[doNotExist], collapse=", "))
+  }
+  return(tipData(phy)[comm])
 }
 
 # abundance assignment function
-`abundance<-` <- function(phy, value) {
-  tipData(phy)$abundance <- value
+`abundance<-` <- function(phy, comm, tip, value) {
+  if (!is.atomic(comm) || length(comm)!=1) {
+    stop("comm must be a vector of length 1")
+  } else if (!comm %in% names(phy at metadata$comms)) {
+    stop(paste("community", comm, "not found in phy", sep=" "))
+  }
+  if (missing(tip)) tip <- tipLabels(phy)
+  tipData(phy)[tip, comm] <- value
   return(phy)
 }
 
@@ -85,7 +97,6 @@
   gsub("_.*$", "", tipLabels(phy))
 }
 
-
 ## this works as implementation of dist.nodes for phylo4 objects, albeit
 ## about 1.5x slower than dist.nodes
 pairdist <- function(phy, type=c("all", "tip"), use.labels=FALSE) {