dropped plyr from imports fix #159

ropensci · Jun 7, 2015 · 99f7209 · 99f7209
1 parent 01df26b
commit 99f7209
Show file tree

Hide file tree

Showing 22 changed files with 292 additions and 121 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -7,7 +7,7 @@ Description: A programmatic interface to the Web Service methods
     taxonomic names, retrieving information on data providers,
     getting species occurrence records, and getting counts of
     occurrence records.
-Version: 0.8.2.9000
+Version: 0.8.3.9000
 License: MIT + file LICENSE
 Authors@R: c(person("Scott", "Chamberlain", role = c("aut", "cre"),
     email = "myrmecocystus@gmail.com"),
@@ -24,7 +24,6 @@ VignetteBuilder: knitr
 Roxygen: list(wrap = FALSE)
 Imports:
     XML,
-    plyr,
     ggplot2,
     maps,
     httr,

diff --git a/NAMESPACE b/NAMESPACE
@@ -34,7 +34,6 @@ export(gbifmap)
 export(gbifparser)
 export(gbifparser_verbatim)
 export(installations)
-export(ldfast)
 export(name_backbone)
 export(name_lookup)
 export(name_suggest)
@@ -60,7 +59,6 @@ import(ggplot2)
 import(grid)
 import(httr)
 import(maps)
-import(plyr)
 import(whisker)
 importFrom(V8,new_context)
 importFrom(XML,getNodeSet)

diff --git a/NEWS b/NEWS
@@ -19,6 +19,7 @@ packages `sp` and `rgeos`, which are no longer imported (#155)
 * Added note to docs about difference between `/search` and `/count`
 services, and how they work. (#150)
 * Added tests for habitat parameter in `name_lookup()` (#149)
+* Dropped plyr from Imports (#159)
 
 BUG FIXES
 

diff --git a/R/check_wkt.r b/R/check_wkt.r
@@ -1,6 +1,5 @@
 #' Check input WKT
 #'
-#' @import plyr
 #' @importFrom stringr str_extract
 #' @export
 #' @param wkt A Well Known Text object
@@ -34,7 +33,7 @@ check_wkt <- function(wkt = NULL){
       stop(res$message, call. = FALSE)
     }
     return(wkt)
-  } else { 
-    NULL 
+  } else {
+    NULL
   }
 }
diff --git a/R/count_facet.r b/R/count_facet.r
@@ -1,6 +1,5 @@
 #' Facetted count occurrence search.
 #'
-#' @import plyr
 #' @param keys (numeric) GBIF keys, a vector.
 #' @param by (character) One of georeferenced, basisOfRecord, country, or
 #' publishingCountry.
@@ -39,17 +38,18 @@
 #' count_facet(by="basisOfRecord")
 #' }
 
-count_facet <- function(keys = NULL, by = 'country', countries = 10, removezeros = FALSE)
-{
+count_facet <- function(keys = NULL, by = 'country', countries = 10, removezeros = FALSE) {
+  
   # can't do both keys and basisofrecord
-  if(!is.null(keys) && by=='basisOfRecord')
+  if (!is.null(keys) && by == 'basisOfRecord') {
     stop("you can't pass in both keys and have by='basisOfRecord'")
+  }
 
   # faceting data vectors
-  if(is.numeric(countries)){
-    countrynames <- list(country=as.character(isocodes$code)[1:countries])
+  if (is.numeric(countries)) {
+    countrynames <- list(country = as.character(isocodes$code)[1:countries])
   } else{
-    countrynames <- list(country=as.character(countries))
+    countrynames <- list(country = as.character(countries))
   }
   georefvals <- list(georeferenced = c(TRUE, FALSE))
   basisvals <- list(basisOfRecord =
@@ -62,39 +62,40 @@ count_facet <- function(keys = NULL, by = 'country', countries = 10, removezeros
                   country = countrynames,
                   publishingCountry = countrynames)
 
-  if(!is.null(keys)){
-    out <- lapply(keys, occ_by_keys, tt=byvar)
+  if (!is.null(keys)) {
+    out <- lapply(keys, occ_by_keys, tt = byvar)
     names(out) <- keys
-    df <- ldply(out, function(x){
-      tmp <- ldply(x)
+    df <- ldfast_names(lapply(out, function(x){
+      tmp <- rbind_rows(x)
       names(tmp)[1] <- by
       tmp
-    })
-  } else
-  {
+    }))
+  } else {
     out <- occ_by(byvar)
-    df <- ldply(out)
+    df <- rbind_rows(out)
     names(df)[1] <- by
     df
   }
 
   # remove NAs (which were caused by errors in country names)
   df <- na.omit(df)
 
-  if(removezeros)
-    df[!df$V1==0,]
-  else
+  if (removezeros) {
+    df[!df$V1 == 0, ]
+  } else {
     df
+  }
 }
 
 # Function to get data for each name
 occ_by_keys <- function(spkey=NULL, tt){
-  occ_count_safe <- plyr::failwith(NULL, occ_count)
+  occ_count_safe <- fail_with(NULL, occ_count)
   tmp <- lapply(tt[[1]], function(x){
     xx <- list(x)
     names(xx) <- names(tt)
-    if(!is.null(spkey))
+    if (!is.null(spkey)) {
       xx$taxonKey <- spkey
+    }
     do.call(occ_count_safe, xx)
   })
   names(tmp) <- tt[[1]]
@@ -104,7 +105,7 @@ occ_by_keys <- function(spkey=NULL, tt){
 
 # Function to get data for each name
 occ_by <- function(tt){
-  occ_count_safe <- plyr::failwith(NULL, occ_count)
+  occ_count_safe <- fail_with(NULL, occ_count)
   tmp <- lapply(tt[[1]], function(x){
     xx <- list(x)
     names(xx) <- names(tt)

diff --git a/R/dataset_search.r b/R/dataset_search.r
@@ -105,7 +105,7 @@ dataset_search <- function(query = NULL, country = NULL, type = NULL, keyword =
       out <- parse_dataset(x=tt$results)
     } else
     {
-      out <- do.call(rbind.fill, lapply(tt$results, parse_dataset))
+      out <- do.call(rbind_fill, lapply(tt$results, parse_dataset))
     }
 
     # select output

diff --git a/R/dataset_suggest.r b/R/dataset_suggest.r
@@ -74,7 +74,7 @@ dataset_suggest <- function(query = NULL, country = NULL, type = NULL, subtype =
       out <- parse_suggest(x=tt$results)
     } else
     {
-      out <- do.call(rbind.fill, lapply(tt, parse_suggest))
+      out <- do.call(rbind_fill, lapply(tt, parse_suggest))
     }
   }
 

diff --git a/R/elevation.r b/R/elevation.r
@@ -1,6 +1,6 @@
 #' Get elevation for lat/long points from a data.frame or list of points.
 #'
-#' @import httr plyr
+#' @import httr
 #' @importFrom stringr str_trim
 #' @importFrom data.table rbindlist
 #' @export
@@ -21,10 +21,10 @@
 #' each location in meters.
 #' @references Uses the Google Elevation API at the following link
 #' \url{https://developers.google.com/maps/documentation/elevation/}
-#' @details To get an API key, see instructions at 
-#' \url{https://developers.google.com/maps/documentation/elevation/#api_key}. It should be an 
-#' easy process. Once you have the key pass it in to the \code{key} parameter. You can store 
-#' the key in your \code{.Rprofile} file and read it in via \code{getOption} as in the 
+#' @details To get an API key, see instructions at
+#' \url{https://developers.google.com/maps/documentation/elevation/#api_key}. It should be an
+#' easy process. Once you have the key pass it in to the \code{key} parameter. You can store
+#' the key in your \code{.Rprofile} file and read it in via \code{getOption} as in the
 #' examples below.
 #' @examples \dontrun{
 #' apikey <- getOption("g_elevation_api")
@@ -46,7 +46,7 @@
 #' }
 
 elevation <- function(input=NULL, latitude=NULL, longitude=NULL, latlong=NULL, key, ...) {
-  
+
   url <- 'https://maps.googleapis.com/maps/api/elevation/json'
   foo <- function(x) gsub("\\s+", "", str_trim(paste(x['latitude'], x['longitude'], sep=","), "both"))
 

diff --git a/R/gbifmap.r b/R/gbifmap.r
@@ -13,19 +13,18 @@
 #' dat <- occ_search(taxonKey=key, return='data', limit=1200)
 #' nrow(dat)
 #' gbifmap(input=dat)
-#' 
+#'
 #' # More than 1 species
-#' library("plyr")
 #' splist <- c('Cyanocitta stelleri', 'Junco hyemalis', 'Aix sponsa')
 #' keys <- sapply(splist, function(x) name_backbone(x)$speciesKey,
 #'    USE.NAMES=FALSE)
 #' dat <- occ_search(taxonKey=keys, return='data', limit=50)
-#' gbifmap(ldply(dat))
+#' gbifmap(do.call("rbind_fill", dat))
 #' }
 
 gbifmap <- function(input = NULL, mapdatabase = "world", region = ".",
-                    geom = geom_point, jitter = NULL, customize = NULL)
-{
+                    geom = geom_point, jitter = NULL, customize = NULL) {
+  
   tomap <- input[complete.cases(input$decimalLatitude, input$decimalLatitude), ]
   tomap <- tomap[!tomap$decimalLongitude==0 & !tomap$decimalLatitude==0,]
   tomap <- tomap[-(which(tomap$decimalLatitude <=90 || tomap$decimalLongitude <=180)), ]

diff --git a/R/name_backbone.r b/R/name_backbone.r
@@ -61,7 +61,7 @@ name_backbone <- function(name, rank=NULL, kingdom=NULL, phylum=NULL, class=NULL
                        strict=strict, verbose=verbose, offset=start, limit=limit))
   tt <- gbif_GET(url, args, FALSE, ...)
   if(verbose){
-    alt <- do.call(rbind.fill, lapply(tt$alternatives, backbone_parser))
+    alt <- do.call(rbind_fill, lapply(tt$alternatives, backbone_parser))
     dat <- data.frame(tt[!names(tt) %in% c("alternatives","note")], stringsAsFactors=FALSE)
     structure(list(data=dat, alternatives=alt), note=tt$note)
   } else

diff --git a/R/name_lookup.r b/R/name_lookup.r
@@ -40,7 +40,7 @@
 #'
 #' # Limit records to certain number
 #' name_lookup('Helianthus annuus', rank="species", limit=2)
-#' 
+#'
 #' # Query by habitat
 #' name_lookup(habitat = "terrestrial", limit=2)
 #' name_lookup(habitat = "marine", limit=2)
@@ -55,7 +55,7 @@
 #' name_lookup(facet='datasetKey', limit=0)
 #' name_lookup(facet='rank', limit=0)
 #' name_lookup(facet='isExtinct', limit=0)
-#' 
+#'
 #' name_lookup(isExtinct=TRUE, limit=0)
 #'
 #' # text highlighting
@@ -69,7 +69,7 @@
 #'
 #' # Lookup by datasetKey
 #' name_lookup(datasetKey='3f8a1297-3259-4700-91fc-acc4170b27ce')
-#' 
+#'
 #' # Pass on httr options
 #' library('httr')
 #' name_lookup(query='Cnaemidophorus', rank="genus", config=verbose())
@@ -79,14 +79,14 @@ name_lookup <- function(query=NULL, rank=NULL, higherTaxonKey=NULL, status=NULL,
   habitat=NULL, nameType=NULL, datasetKey=NULL, nomenclaturalStatus=NULL,
   limit=100, start=NULL, facet=NULL, facetMincount=NULL, facetMultiselect=NULL, type=NULL, hl=NULL,
   verbose=FALSE, return="all", ...) {
-  
+
   if (!is.null(facetMincount) && inherits(facetMincount, "numeric"))
     stop("Make sure facetMincount is character")
   if (!is.null(facet)) {
     facetbyname <- facet
     names(facetbyname) <- rep('facet', length(facet))
   } else {
-    facetbyname <- NULL 
+    facetbyname <- NULL
   }
 
   url <- paste0(gbif_base(), '/species/search')
@@ -107,12 +107,12 @@ name_lookup <- function(query=NULL, rank=NULL, higherTaxonKey=NULL, status=NULL,
     facetsdat <- lapply(facets, function(x) do.call(rbind, lapply(x$counts, data.frame, stringsAsFactors = FALSE)))
     names(facetsdat) <- tolower(sapply(facets, "[[", "field"))
   } else {
-    facetsdat <- NULL  
+    facetsdat <- NULL
   }
 
   # actual data
   if (!verbose) {
-    data <- do.call(rbind.fill, lapply(tt$results, namelkupparser))
+    data <- do.call(rbind_fill, lapply(tt$results, namelkupparser))
   } else {
     data <- tt$results
   }
@@ -127,7 +127,7 @@ name_lookup <- function(query=NULL, rank=NULL, higherTaxonKey=NULL, status=NULL,
 
   # vernacular names
   vernames <- lapply(tt$results, function(x){
-    rbind.fill(lapply(x$vernacularNames, data.frame))
+    rbind_fill(lapply(x$vernacularNames, data.frame))
   })
   names(vernames) <- vapply(tt$results, "[[", numeric(1), "key")
 

diff --git a/R/name_suggest.r b/R/name_suggest.r
@@ -56,7 +56,7 @@ name_suggest <- function(q=NULL, datasetKey=NULL, rank=NULL, fields=NULL, start=
       tt[[i]][['higherClassificationMap']] <- data.frame(id=names(temp), name=do.call(c, unname(temp)), stringsAsFactors = FALSE)
     }
     out <- lapply(tt, function(x) x[names(x) %in% toget])
-    df <- do.call(rbind.fill, lapply(out, function(x){
+    df <- do.call(rbind_fill, lapply(out, function(x){
       data.frame(x[ !names(x) %in% "higherClassificationMap" ], stringsAsFactors = FALSE)
     }))
     hier <- sapply(tt, function(x) x[ names(x) %in% "higherClassificationMap" ])
@@ -65,7 +65,7 @@ name_suggest <- function(q=NULL, datasetKey=NULL, rank=NULL, fields=NULL, start=
     list(data=df, hierarchy=hier)
   } else {
     out <- lapply(tt, function(x) x[names(x) %in% toget])
-    do.call(rbind.fill, lapply(out, data.frame, stringsAsFactors = FALSE))
+    do.call(rbind_fill, lapply(out, data.frame, stringsAsFactors = FALSE))
   }
 }
 

diff --git a/R/name_usage.r b/R/name_usage.r
@@ -123,7 +123,7 @@ getdata <- function(x, key, uuid, shortname, args, ...){
 
 name_usage_parse <- function(x){
   if(has_meta(x)){
-    do.call(rbind.fill, lapply(x$results, nameusageparser))
+    do.call(rbind_fill, lapply(x$results, nameusageparser))
   } else {
     nameusageparser(x)
   }

diff --git a/R/nodes.r b/R/nodes.r
@@ -20,29 +20,28 @@
 #' nodes(data=c('identifier','organization','comment'), uuid="03e816b3-8f58-49ae-bc12-4e18b358d6d9")
 #'
 #' uuids = c("8cb55387-7802-40e8-86d6-d357a583c596","02c40d2a-1cba-4633-90b7-e36e5e97aba8",
-#' "7a17efec-0a6a-424c-b743-f715852c3c1f","b797ce0f-47e6-4231-b048-6b62ca3b0f55",
-#' "1193638d-32d1-43f0-a855-8727c94299d8","d3499f89-5bc0-4454-8cdb-60bead228a6d",
-#' "cdc9736d-5ff7-4ece-9959-3c744360cdb3","a8b16421-d80b-4ef3-8f22-098b01a89255",
-#' "8df8d012-8e64-4c8a-886e-521a3bdfa623","b35cf8f1-748d-467a-adca-4f9170f20a4e",
-#' "03e816b3-8f58-49ae-bc12-4e18b358d6d9","073d1223-70b1-4433-bb21-dd70afe3053b",
-#' "07dfe2f9-5116-4922-9a8a-3e0912276a72","086f5148-c0a8-469b-84cc-cce5342f9242",
-#' "0909d601-bda2-42df-9e63-a6d51847ebce","0e0181bf-9c78-4676-bdc3-54765e661bb8",
-#' "109aea14-c252-4a85-96e2-f5f4d5d088f4","169eb292-376b-4cc6-8e31-9c2c432de0ad",
-#' "1e789bc9-79fc-4e60-a49e-89dfc45a7188","1f94b3ca-9345-4d65-afe2-4bace93aa0fe")
+#'   "7a17efec-0a6a-424c-b743-f715852c3c1f","b797ce0f-47e6-4231-b048-6b62ca3b0f55",
+#'   "1193638d-32d1-43f0-a855-8727c94299d8","d3499f89-5bc0-4454-8cdb-60bead228a6d",
+#'   "cdc9736d-5ff7-4ece-9959-3c744360cdb3","a8b16421-d80b-4ef3-8f22-098b01a89255",
+#'   "8df8d012-8e64-4c8a-886e-521a3bdfa623","b35cf8f1-748d-467a-adca-4f9170f20a4e",
+#'   "03e816b3-8f58-49ae-bc12-4e18b358d6d9","073d1223-70b1-4433-bb21-dd70afe3053b",
+#'   "07dfe2f9-5116-4922-9a8a-3e0912276a72","086f5148-c0a8-469b-84cc-cce5342f9242",
+#'   "0909d601-bda2-42df-9e63-a6d51847ebce","0e0181bf-9c78-4676-bdc3-54765e661bb8",
+#'   "109aea14-c252-4a85-96e2-f5f4d5d088f4","169eb292-376b-4cc6-8e31-9c2c432de0ad",
+#'   "1e789bc9-79fc-4e60-a49e-89dfc45a7188","1f94b3ca-9345-4d65-afe2-4bace93aa0fe")
 #'
-#' library('plyr')
 #' res <- lapply(uuids, function(x) nodes(x, data='identifier')$data)
 #' res <- res[!sapply(res, length)==0]
-#' ldply(res)
+#' do.call("rbind_fill", res)
 #'
 #' # Pass on options to httr
 #' library('httr')
 #' res <- nodes(limit=20, config=progress())
 #' }
 
 nodes <- function(data = 'all', uuid = NULL, query = NULL, identifier=NULL,
-  identifierType=NULL, limit=100, start=NULL, isocode = NULL, ...)
-{
+  identifierType=NULL, limit=100, start=NULL, isocode = NULL, ...) {
+
   args <- rgbif_compact(list(q = query, limit=as.integer(limit), offset=start))
 
   data <- match.arg(data, choices=c('all', 'organization', 'endpoint',

diff --git a/R/occ_metadata.r b/R/occ_metadata.r
@@ -1,7 +1,6 @@
 #' Search for catalog numbers, collection codes, collector names, and institution
 #' codes.
 #'
-#' @import httr plyr
 #' @export
 #'
 #' @param type Type of data, one of catalog_number, collection_code, collector_name,

diff --git a/R/occ_search.r b/R/occ_search.r
@@ -1,7 +1,7 @@
 #' Search for GBIF occurrences.
 #'
 #' @export
-#' @import httr plyr
+#' @import httr
 #' @importFrom XML getNodeSet xmlAttrs xmlSApply xmlValue htmlParse xpathApply xmlToList
 #'
 #' @template occsearch

diff --git a/R/parsenames.R b/R/parsenames.R
@@ -34,5 +34,5 @@ parsenames <- function(scientificname, ...) {
   stopifnot(tt$headers$`content-type`=='application/json')
   temp <- content(tt, as = 'text', encoding = "UTF-8")
   res <- jsonlite::fromJSON(temp, FALSE)
-  do.call(rbind.fill, lapply(res, as.data.frame))
+  do.call(rbind_fill, lapply(res, as.data.frame))
 }