** v0.7.1 **� Bugfix due to a small regression in listPFTs(). Also took the opportunity to include examples for listPFTs, unit tests for listPFTs, and changed the 'print' functions to 'show' functions as is appropriate for S4 methods (but this does not effect users since print/show methods seem to dispatch to each depending on the appropriate class type).

Author: MagicForrest

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: DGVMTools
 Type: Package
-Version: 0.7.0
+Version: 0.7.1
 Title: DGVM Processing, Analysis and Plotting Tools
 Date: 2019-02-27
 Authors@R: c(person("Matthew", "Forrest", role=c("aut", "cre"), email="[email protected]"),
@@ -91,14 +91,14 @@ Collate:
     'plotSpatialComparison.R'
     'plotTemporal.R'
     'plotting-framework-functions.R'
-    'print-methods.R'
     'renameLayers.R'
     'selectDays.R'
     'selectGridcells.R'
     'selectLayers.R'
     'selectMonths.R'
     'selectSeasons.R'
     'selectYears.R'
+    'show-methods.R'
     'small-utility-functions.R'
     'summary-methods.R'
     'writeField-methods.R'

NAMESPACE

@@ -76,7 +76,6 @@ export(plotSeasonal)
 export(plotSpatial)
 export(plotSpatialComparison)
 export(plotTemporal)
-export(print)
 export(promoteToRaster)
 export(proportionsComparison)
 export(renameLayers)
@@ -110,12 +109,13 @@ exportMethods(crop)
 exportMethods(extent)
 exportMethods(layers)
 exportMethods(names)
-exportMethods(print)
+exportMethods(show)
 exportMethods(summary)
 exportMethods(writeField)
 exportMethods(writeNetCDF)
 import(data.table)
 import(ggplot2)
 import(methods)
+importMethodsFrom(methods,show)
 importMethodsFrom(raster,crop)
 importMethodsFrom(raster,extent)

R/Format-GUESS.R

@@ -1001,7 +1001,7 @@ GUESS.PFTs <- list(
   ),
 
   # BNS
-  BNS = new("PFT",
+  new("PFT",
             id = "BNS",
             name = "Boreal Needleleaved Summergreen Tree",
             growth.form = "Tree",

R/listPFTs.R

@@ -4,55 +4,106 @@
 #' 
 #' @param x Either a Field, or a list of PFT objects
 #' @param criteria A character string to use to select PFTs.  This compared to every the value of every slot of a PFT object.  If one matches, the PFT is inlucded in the return.
-#  If left empty return all PFTs ()
+#  If left empty or set to NULL the return all PFTs.
 #' @param return.ids A logical, if TRUE (default) then return the the id of the PFT, if FALSE return the entire PFT object
 #' 
-#' @return Either a list of characters (the ids of the PFTs) or a list of PFT object (depending on argument return.ids)
-#' 
+#' @return Either a vector of characters (the ids of the PFTs) or a list of PFT object (depending on argument return.ids)
 #' 
 #' @author Matthew Forrest \email{matthew.forrest@@senckenberg.de}
+#' 
+#' @examples
+#' 
+#' ## List PFTs from a list of PFT objects
+#' 
+#' # make a list of PFTs for selecting from 
+#' PFT.list <- [email protected]
+#' print(PFT.list)
+#' 
+#' # return with no criteria (trivial)
+#' listPFTs(PFT.list)
+#' 
+#' # return as the full PFT objects
+#' listPFTs(PFT.list, return.ids = FALSE)
+#' 
+#' # return Tree, Grass, Evergreen and Tropical PFTs
+#' listPFTs(PFT.list, criteria = "Tree")
+#' listPFTs(PFT.list, criteria = "Grass")
+#' listPFTs(PFT.list, criteria = "Evergreen")
+#' listPFTs(PFT.list, criteria = "Tropical")
+#' 
+#' # return Tropical PFTs as a list of PFTs objects (not just the ids)
+#' listPFTs(PFT.list, criteria = "Tropical", return.ids = FALSE)
+#' 
+#' \donttest{
+#'  
+#' ## List PFTs from a Field object
+#' 
+#' # Load a per-PFT Field from the example data
+#' run.dir <- system.file("extdata", "LPJ-GUESS_Runs", "CentralEurope", package = "DGVMTools")
+#' test.Source <- defineSource(id = "LPJ-GUESS_Example", dir = run.dir,  format = GUESS)
+#' test.Field.perPFT <- getField(source = test.Source, var = "lai") 
+#' 
+#' # Perform the same examples as above but with the Field instead of a list of PFTs objects
+#' 
+#' # return with no criteria (trivial)#' 
+#' listPFTs(test.Field.perPFT )
+#' 
+#' # return as the full PFT objects
+#' listPFTs(test.Field.perPFT, return.ids = FALSE)
+#' 
+#' # return Tree, Grass, Evergreen and Tropical PFTs
+#' listPFTs(test.Field.perPFT, criteria = "Tree")
+#' listPFTs(test.Field.perPFT, criteria = "Grass")
+#' listPFTs(test.Field.perPFT, criteria = "Evergreen")
+#' listPFTs(test.Field.perPFT, criteria = "Tropical")
+#' 
+#' # return Tropical PFTs as a list of PFTs objects (not just the ids)
+#' listPFTs(test.Field.perPFT, criteria = "Tropical", return.ids = FALSE)
+#' 
+#' }
+#' 
 #' @export
 
 listPFTs <- function(x, criteria = NULL, return.ids = TRUE) {
 
 
-  # check input and get the PFT superset
-  # if Field
-  if(is.Field(x)) pft.list <- x@source@pft.set
-  # if list
+  # first prepare a list of all PFTs present
+  
+  # if Field compare the layers of x with the PFTs in the Format object
+  if(is.Field(x)) {
+    pft.list <- list()
+    for(this.PFT in x@source@pft.set) {
+      if(this.PFT@id %in% layers(x)) pft.list <- append(pft.list, this.PFT)
+    }
+  }
+  
+  # else if list, check that all elements are a PFT
   else if(is.list(x)){
     for(this in x) {
       if(!is.PFT(this)) stop("At least one item in the input list is not an object PFT class")
     }
     pft.list <- x
   }  
+  
   # else fail
   else {
     stop("Unexpected input for argument 'x' in listPFTs().")
   }
 
-  # get a list of the layers of x, to check that the PFT is actually present
-  layers.x <- names(x)
-  
 
   # now check each PFT in X to see if it matches the criteria
   matched.pfts <- list()
   if(!is.null(criteria)) criteria <- tolower(criteria)
   for(PFT in pft.list) {
 
-    # check PFT is present in data.table 
-    if(PFT@id %in% layers.x) {
+    if(tolower(PFT@growth.form) == criteria 
+       || tolower(PFT@climate.zone) == criteria
+       || tolower(PFT@leaf.form) == criteria 
+       || tolower(PFT@phenology) == criteria
+       || is.null(criteria)) {
 
-      if(tolower(PFT@growth.form) == criteria 
-         || tolower(PFT@climate.zone) == criteria
-         || tolower(PFT@leaf.form) == criteria 
-         || tolower(PFT@phenology) == criteria
-         || is.null(criteria)) {
-        
-        if(return.ids) matched.pfts[[PFT@id]] <- PFT@id 
-        else matched.pfts[[PFT@id]] <- PFT
-        
-      }
+      if(return.ids) matched.pfts[[PFT@id]] <- PFT@id 
+      else matched.pfts[[PFT@id]] <- PFT
 
     }