added synonyms fxn for nbn, and to master synonyms fxns, closes #332

ropensci · Oct 2, 2014 · d4fe8a4 · d4fe8a4
1 parent cf5e088
commit d4fe8a4
Show file tree

Hide file tree

Showing 5 changed files with 91 additions and 40 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -31,6 +31,7 @@ S3method(sci2comm,tsn)
 S3method(sci2comm,uid)
 S3method(synonyms,default)
 S3method(synonyms,ids)
+S3method(synonyms,nbnid)
 S3method(synonyms,tpsid)
 S3method(synonyms,tsn)
 S3method(synonyms,ubioid)
@@ -143,6 +144,7 @@ export(iucn_summary)
 export(names_list)
 export(nbn_classifcation)
 export(nbn_search)
+export(nbn_synonyms)
 export(ncbi_children)
 export(ncbi_get_taxon_summary)
 export(ncbi_getbyid)

diff --git a/R/nbn_synonyms.R b/R/nbn_synonyms.R
@@ -0,0 +1,18 @@
+#' Return all synonyms for a taxon name with a given id from NBN
+#'
+#' @export
+#' 
+#' @param id the taxon identifier code
+#' @param ... Further args passed on to \code{\link[httr]{GET}}
+#' @return A data.frame
+#' @examples \donttest{
+#' nbn_synonyms(id = 'NHMSYS0000502940')
+#' nbn_synonyms(id = 'NHMSYS0001501147')
+#' nbn_synonyms(id = 'NHMSYS0000456036')
+#' }
+
+nbn_synonyms <- function(id, ...)
+{
+  url <- sprintf("https://data.nbn.org.uk/api/taxa/%s/synonyms", id)
+  nbn_GET_2(url, ...)
+}
diff --git a/R/synonyms.R b/R/synonyms.R
@@ -2,16 +2,18 @@
 #'
 #' @param x character; taxons to query.
 #' @param db character; database to query. either \code{itis}, \code{tropicos},
-#' or \code{ubio}.
+#' \code{ubio}, or \code{nbn}.
 #' @param id character; identifiers, returned by \code{\link[taxize]{get_tsn}},
-#'    \code{\link[taxize]{get_tpsid}}, or \code{\link[taxize]{get_ubioid}}
+#'    \code{\link[taxize]{get_tpsid}}, \code{\link[taxize]{get_ubioid}}, or
+#'    \code{\link[taxize]{get_nbnid}}
 #' @param ... Other passed arguments.
 #'
 #' @return A named list of data.frames with the synonyms of every supplied taxa.
 #' @note If IDs are supplied directly (not from the \code{get_*} functions) you
 #'    must specify the type of ID.
 #'
-#' @seealso \code{\link[taxize]{get_tsn}}, \code{\link[taxize]{get_tpsid}}
+#' @seealso \code{\link[taxize]{get_tsn}}, \code{\link[taxize]{get_tpsid}}, 
+#' \code{\link[taxize]{get_ubioid}}, \code{\link[taxize]{get_nbnid}}
 #'
 #' @export
 #' @examples \donttest{
@@ -23,11 +25,13 @@
 #' synonyms(c("Poa annua",'Pinus contorta'), db="tropicos")
 #' synonyms("Salmo friderici", db='ubio')
 #' synonyms(c("Salmo friderici",'Carcharodon carcharias','Puma concolor'), db="ubio")
+#' synonyms("Pinus sylvestris", db='nbn')
 #'
-#' # Use methods for get_tsn, get_tpsid
+#' # Use get_* methods
 #' synonyms(get_tsn("Poa annua"))
 #' synonyms(get_tpsid("Poa annua"))
 #' synonyms(get_ubioid("Carcharodon carcharias"))
+#' synonyms(get_nbnid("Carcharodon carcharias"))
 #'
 #' # Pass many ids from class "ids"
 #' out <- get_ids(names="Poa annua", db = c('itis','tropicos'))
@@ -59,6 +63,11 @@ synonyms.default <- function(x, db = NULL, ...){
     out <- synonyms(id, ...)
     names(out) <- x
   }
+  if (db == 'nbn') {
+    id <- get_nbnid(x, ...)
+    out <- synonyms(id, ...)
+    names(out) <- x
+  }
   return(out)
 }
 
@@ -68,19 +77,15 @@ synonyms.default <- function(x, db = NULL, ...){
 synonyms.tsn <- function(id, ...)
 {
   fun <- function(x){
-    if (is.na(x)) {
-      out <- NA
-    } else {
+    if (is.na(x)) { NA } else {
       out <- getsynonymnamesfromtsn(x, ...)
-      if(as.character(out[1,1]) == 'nomatch')
-        names(out) <- c('name','tsn')
+      if(as.character(out[1,1]) == 'nomatch') names(out) <- c('name','tsn')
+      out
     }
-    out
   }
   tmp <- lapply(id, fun)
   names(tmp) <- id
   return(tmp)
-#   return( lapply(id, fun) )
 }
 
 #' @method synonyms tpsid
@@ -89,17 +94,13 @@ synonyms.tsn <- function(id, ...)
 synonyms.tpsid <- function(id, ...)
 {
   fun <- function(x){
-    if (is.na(x)) {
-      out <- NA
-    } else {
-      out <- tp_synonyms(x, ...)$synonyms
+    if (is.na(x)) { NA } else {
+      tp_synonyms(x, ...)$synonyms
     }
-    out
   }
   tmp <- lapply(id, fun)
   names(tmp) <- id
   return(tmp)
-#   return( lapply(id, fun) )
 }
 
 #' @method synonyms ubioid
@@ -108,18 +109,29 @@ synonyms.tpsid <- function(id, ...)
 synonyms.ubioid <- function(id, ...)
 {
   fun <- function(x){
-    if (is.na(x)) {
-      out <- NA
-    } else {
-      out <- ubio_id(namebankID = x, ...)[['synonyms']]
+    if (is.na(x)) { NA  } else {
+      ubio_id(namebankID = x, ...)[['synonyms']]
     }
-    out
   }
   tmp <- lapply(id, fun)
   names(tmp) <- id
   return(tmp)
 }
 
+#' @method synonyms nbnid
+#' @export
+#' @rdname synonyms
+synonyms.nbnid <- function(id, ...)
+{
+  fun <- function(x){
+    if (is.na(x)) { NA } else {
+      nbn_synonyms(x, ...)
+    }
+  }
+  tmp <- lapply(id, fun)
+  names(tmp) <- id
+  return(tmp)
+}
 
 #' @method synonyms ids
 #' @export
@@ -136,17 +148,3 @@ synonyms.ids <- function(id, ...)
   }
   return( lapply(id, fun) )
 }
-
-# x <- "Poa annua"
-# # ubioout <- ubio_search(searchName=x, sci = 1)
-# # let's use 5408026
-# # ubiodat <- ubio_synonyms(hierarchiesID = 5408026)
-#
-# searchbyscientificname(srchkey=x) # let's use 41107
-# getsynonymnamesfromtsn(tsn = 41107)
-#
-# tpout <- tp_search(name = 'Poa annua')
-# tp_search('Pinus contorta')
-# head(tpout) # use 25509881
-# tp_synonyms(id = 25509881)
-# tp_synonyms(id = 24900183)
diff --git a/man/nbn_synonyms.Rd b/man/nbn_synonyms.Rd
@@ -0,0 +1,26 @@
+% Generated by roxygen2 (4.0.2): do not edit by hand
+\name{nbn_synonyms}
+\alias{nbn_synonyms}
+\title{Return all synonyms for a taxon name with a given id from NBN}
+\usage{
+nbn_synonyms(id, ...)
+}
+\arguments{
+\item{id}{the taxon identifier code}
+
+\item{...}{Further args passed on to \code{\link[httr]{GET}}}
+}
+\value{
+A data.frame
+}
+\description{
+Return all synonyms for a taxon name with a given id from NBN
+}
+\examples{
+\donttest{
+nbn_synonyms(id = 'NHMSYS0000502940')
+nbn_synonyms(id = 'NHMSYS0001501147')
+nbn_synonyms(id = 'NHMSYS0000456036')
+}
+}
+
diff --git a/man/synonyms.Rd b/man/synonyms.Rd
@@ -3,6 +3,7 @@
 \alias{synonyms}
 \alias{synonyms.default}
 \alias{synonyms.ids}
+\alias{synonyms.nbnid}
 \alias{synonyms.tpsid}
 \alias{synonyms.tsn}
 \alias{synonyms.ubioid}
@@ -18,6 +19,8 @@ synonyms(...)
 
 \method{synonyms}{ubioid}(id, ...)
 
+\method{synonyms}{nbnid}(id, ...)
+
 \method{synonyms}{ids}(id, ...)
 }
 \arguments{
@@ -26,10 +29,11 @@ synonyms(...)
 \item{x}{character; taxons to query.}
 
 \item{db}{character; database to query. either \code{itis}, \code{tropicos},
-or \code{ubio}.}
+\code{ubio}, or \code{nbn}.}
 
 \item{id}{character; identifiers, returned by \code{\link[taxize]{get_tsn}},
-\code{\link[taxize]{get_tpsid}}, or \code{\link[taxize]{get_ubioid}}}
+\code{\link[taxize]{get_tpsid}}, \code{\link[taxize]{get_ubioid}}, or
+\code{\link[taxize]{get_nbnid}}}
 }
 \value{
 A named list of data.frames with the synonyms of every supplied taxa.
@@ -51,18 +55,21 @@ synonyms("Pinus contorta", db="tropicos")
 synonyms(c("Poa annua",'Pinus contorta'), db="tropicos")
 synonyms("Salmo friderici", db='ubio')
 synonyms(c("Salmo friderici",'Carcharodon carcharias','Puma concolor'), db="ubio")
+synonyms("Pinus sylvestris", db='nbn')
 
-# Use methods for get_tsn, get_tpsid
+# Use get_* methods
 synonyms(get_tsn("Poa annua"))
 synonyms(get_tpsid("Poa annua"))
 synonyms(get_ubioid("Carcharodon carcharias"))
+synonyms(get_nbnid("Carcharodon carcharias"))
 
 # Pass many ids from class "ids"
 out <- get_ids(names="Poa annua", db = c('itis','tropicos'))
 synonyms(out)
 }
 }
 \seealso{
-\code{\link[taxize]{get_tsn}}, \code{\link[taxize]{get_tpsid}}
+\code{\link[taxize]{get_tsn}}, \code{\link[taxize]{get_tpsid}},
+\code{\link[taxize]{get_ubioid}}, \code{\link[taxize]{get_nbnid}}
 }