Merge pull request #6 from ices-tools-prod/master

CRAN 1.1-0

DESCRIPTION

@@ -1,14 +1,12 @@
 Package: icesVocab
 Version: 1.1-0
-Date: 2016-12-05
+Date: 2016-12-08
 Title: ICES Vocabularies Database Web Services
 Authors@R: c(person("Colin", "Millar", role=c("aut","cre"), email="[email protected]"),
              person("Arni", "Magnusson", role="aut"))
-Imports: RCurl,
-         utils,
+Imports: utils,
          XML
-Suggests: knitr,
-          testthat
+Suggests: testthat
 Description: R interface to access the RECO POX web services of the ICES (International
              Council for the Exploration of the Sea) Vocabularies database <http://vocab.ices.dk/services/POX.aspx>.
 License: GPL (>= 2)

NAMESPACE

@@ -1,13 +1,15 @@
 # Generated by roxygen2: do not edit by hand
 
 export(findAphia)
+export(findCode)
+export(findCodeType)
 export(getCodeDetail)
 export(getCodeList)
 export(getCodeTypeList)
-importFrom(RCurl,basicTextGatherer)
-importFrom(RCurl,curlPerform)
 importFrom(XML,getChildrenStrings)
 importFrom(XML,removeNodes)
 importFrom(XML,xmlParse)
 importFrom(XML,xmlRoot)
 importFrom(XML,xmlSize)
+importFrom(XML,xmlToList)
+importFrom(utils,download.file)

NEWS

@@ -0,0 +1,22 @@
+--------------------------------------------------------------------------------
+icesVocab 1.1-0 (2016-12-08)
+--------------------------------------------------------------------------------
+o Added function findAphia() to look up species codes.
+
+o Added function findCode() to look up codes given a code type.
+
+o Added function findCodeType() to look up code types.
+
+o Improved XML parsing, so both leading and trailing white space is removed.
+
+o Improved XML parsing, so "" and "NA" is converted to NA.
+
+o Improved XML parsing of code details so that child and parent relations are returned.
+
+o Improved url reading to avoid the use of RCurl.
+
+
+--------------------------------------------------------------------------------
+icesVocab 1.0-0 (2016-09-15)
+--------------------------------------------------------------------------------
+o Initial release.

R/findCode.R

@@ -0,0 +1,73 @@
+#' Find a Key
+#'
+#' Look up a key for a given code and code type.
+#'
+#' @param code_type a search string for a code type, e.g. SpecWorms, or simply worms.
+#' @param code a search string for a code, e.g. a species name, cod, or ship name, Clupea.
+#' @param regex whether to match as a regular expression.
+#' @param full whether to return a data frame.
+#'
+#' @details Matches are case-insensitive.
+#'
+#' @return A vector of keys (default) or a data frame if full is TRUE.
+#'
+#' @seealso
+#' \code{\link{getCodeList}} can be used to get all code types; see example on
+#' that help page.
+#'
+#' \code{\link{icesVocab-package}} gives an overview of the package.
+#'
+#' @examples
+#' findCode("aphia", "cod")
+#'
+#' # Multiple matches
+#' findCode("aphia", c("cod", "haddock", "saithe"), full = TRUE)
+#'
+#' findCodeType("ship", full = TRUE)
+#' findCode("ship", "clupea", full = TRUE)
+#'
+#'
+#' @export
+
+findCode <- function(code_type, code, regex = TRUE, full = FALSE) {
+
+  # get code types
+  type <- findCodeType(code_type, regex = regex)
+  # if multiple types - don't combine
+  if (length(type) == 0) {
+    return(NULL) # ?
+  }
+  codes <- lapply(type, getCodeList)
+
+  # apply filters (to each list element)
+  code <- tolower(as.character(code))
+  if (!regex) code <- paste0("^", code, "$")
+  codes <-
+    lapply(codes,
+      function(x) {
+        select <- c(unlist(lapply(code, grep, tolower(x$LongDescription))),
+                    unlist(lapply(code, grep, tolower(x$Description))),
+                    unlist(lapply(code, grep, tolower(x$Key))))
+        select <- sort(unique(select))
+        x <- x[select,]
+
+        if (full) {
+          x
+        } else {
+          x$Key
+        }
+      })
+
+  # add type as name
+  names(codes) <- type
+
+  # drop empty types
+  if (full) {
+    codes <- codes[sapply(codes, nrow) > 0]
+  } else {
+    codes <- codes[sapply(codes, length) > 0]
+  }
+
+  # return
+  codes
+}

R/findCodeType.R

@@ -0,0 +1,48 @@
+#' Find a Key
+#'
+#' Find a lookup key corresponding to a code type.
+#'
+#' @param code a code name, e.g. Gear Type, or DATRAS to find all DATRAS related codes.
+#' @param date restrict output to code types modified after a given date in
+#'        yyyy-mm-dd format, e.g. "2010-12-01"
+#' @param regex whether to match the stock name as a regular expression.
+#' @param full whether to return a data frame with all stock list columns.
+#'
+#' @return A vector of keys (default) or a data frame if full is TRUE.
+#'
+#' @seealso
+#' \code{\link{getCodeTypeList}} gets a list of code types.
+#'
+#' \code{\link{icesVocab-package}} gives an overview of the package.
+#'
+#' @examples
+#' findCodeType("worms")
+#'
+#' findCodeType("DATRAS", full = TRUE)
+#'
+#' findCodeType("DATRAS", full = TRUE, date = "2010-01-01")
+#'
+#' @export
+
+findCodeType <- function(code, date = NULL, regex = TRUE, full = FALSE)
+{
+
+  # get code list
+  types <- getCodeTypeList(date)
+
+  # apply filters
+  code <- tolower(code)
+  if (!regex) code <- paste0("^", code, "$")
+  select <- c(unlist(lapply(code, grep, tolower(types$LongDescription))),
+              unlist(lapply(code, grep, tolower(types$Description))),
+              unlist(lapply(code, grep, tolower(types$Key))))
+  select <- sort(unique(select))
+  types <- types[select,]
+
+  # return
+  if (full) {
+    types
+  } else {
+    types$Key
+  }
+}

R/getCodeDetail.R

@@ -13,24 +13,31 @@
 #'
 #' \code{\link{icesVocab-package}} gives an overview of the package.
 #'
-#' @author Colin Millar.
-#'
 #' @examples
-#' # Species code 101170
+#' # Species code 101170 - Myxine glutinosa
 #' getCodeDetail("SpecWoRMS", 101170)
 #'
+#' # find details of Haddock using the aphia ID
+#' findCode("species", "haddock", full = TRUE)
+#'
+#' getCodeDetail("SpecWoRMS", 126437)
+#'
+#' # get info for had-43
+#' getCodeDetail("ICES_StockCode", "had-34")
+#'
 #' @export
 
 getCodeDetail <- function(code_type, code) {
-  # read XML string and parse to data frame
+  message("The output from this function is developing.  please do not rely on the current output format")
+
+  # form url
   url <- sprintf("http://vocab.ices.dk/services/pox/GetCodeDetail/%s/%s",
                  code_type, code)
-  out <- curlVocab(url)
-  out <- parseVocab(out)
 
-  # for now, drop parent and child relations
-  out <- out[!grepl("ParentRelation", names(out))]
-  out <- out[!grepl("ChildRelation", names(out))]
+  # read url contents
+  out <- readVocab(url)
+  # parse the text string returning a dataframe
+  out <- parseVocabDetail(out)
 
   out
 }

R/getCodeList.R

@@ -12,13 +12,17 @@
 #' \code{\link{getCodeTypeList}} and \code{\link{getCodeDetail}} get code types
 #' and code details.
 #'
-#' \code{\link{icesVocab-package}} gives an overview of the package.
+#' \code{\link{findCodeType}} and \code{\link{findAphia}} provide support for searching the code type and code lists.
 #'
-#' @author Colin Millar.
+#' \code{\link{icesVocab-package}} gives an overview of the package.
 #'
 #' @examples
-#' # Species codes
-#' getCodeList("SpecWoRMS")
+#' # Aphia Species codes
+#' findCodeType("aphia", full = TRUE)
+#' codes <- getCodeList("SpecWoRMS")
+#' head(codes)
+#'
+#' findAphia("cod", full = TRUE)
 #'
 #' @export
 
@@ -32,8 +36,9 @@ getCodeList <- function(code_type, date = NULL) {
     url <- sprintf(paste0(url, "/%s"), date)
   }
 
-  # read XML string and parse to data frame
-  out <- curlVocab(url)
+  # read url contents
+  out <- readVocab(url)
+  # parse the text string returning a dataframe
   out <- parseVocab(out)
 
   out

R/getCodeTypeList.R

@@ -12,16 +12,18 @@
 #' \code{\link{getCodeList}} and \code{\link{getCodeDetail}} get codes of a
 #' given type and code details.
 #'
-#' \code{\link{icesVocab-package}} gives an overview of the package.
+#' \code{\link{findCodeType}} searches for a code types based on a search string.
 #'
-#' @author Colin Millar.
+#' \code{\link{icesVocab-package}} gives an overview of the package.
 #'
 #' @examples
 #' # Find code type for World Register of Marine Species (WoRMS)
 #' types <- getCodeTypeList()
 #' types[grep("worms", tolower(types$Description)),]
 #'
-#' # This code type "SpecWoRMS" can be used when calling getCodeList()
+#' findCodeType("worms", full = TRUE)
+#'
+#' # The code type "SpecWoRMS" can be used when calling getCodeList()
 #'
 #' @export
 
@@ -35,10 +37,9 @@ getCodeTypeList <- function(date = NULL) {
     url <- sprintf(paste0(url, "/%s"), date)
   }
 
-  # read and parse XML from API
-  out <- curlVocab(url = url)
-  # parse the xml text string suppplied by the Datras webservice
-  # returning a dataframe
+  # read url contents
+  out <- readVocab(url)
+  # parse the text string returning a dataframe
   out <- parseVocab(out)
 
   # return