Merge pull request #259 from Aariq/aariq-nas

Closes #224.

.Rbuildignore

@@ -29,3 +29,4 @@ README_cache
 ^pkgdown$
 
 .Rmd.orig
+

NAMESPACE

@@ -1,13 +1,16 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(cas,aw_query)
 S3method(cas,chebi_comp_entity)
+S3method(cas,cts_compinfo)
 S3method(cas,default)
+S3method(cas,etox_basic)
+S3method(cas,opsin_query)
 S3method(cas,pan_query)
 S3method(cas,wd_ident)
 S3method(inchikey,aw_query)
 S3method(inchikey,chebi_comp_entity)
-S3method(inchikey,cs_compinfo)
-S3method(inchikey,cs_extcompinfo)
+S3method(inchikey,cts_compinfo)
 S3method(inchikey,default)
 S3method(inchikey,etox_basic)
 S3method(inchikey,opsin_query)
@@ -16,8 +19,6 @@ S3method(inchikey,pc_prop)
 S3method(inchikey,wd_ident)
 S3method(smiles,aw_query)
 S3method(smiles,chebi_comp_entity)
-S3method(smiles,cs_compinfo)
-S3method(smiles,cs_extcompinfo)
 S3method(smiles,cts_compinfo)
 S3method(smiles,default)
 S3method(smiles,etox_basic)
@@ -81,12 +82,15 @@ import(httr)
 import(jsonlite)
 import(rvest)
 import(stringr)
+import(tibble)
 import(xml2)
 importFrom(data.tree,Do)
 importFrom(data.tree,FindNode)
 importFrom(data.tree,as.Node)
 importFrom(dplyr,bind_rows)
+importFrom(dplyr,everything)
 importFrom(dplyr,left_join)
+importFrom(dplyr,select)
 importFrom(httr,GET)
 importFrom(httr,POST)
 importFrom(httr,add_headers)
@@ -104,6 +108,7 @@ importFrom(stats,rgamma)
 importFrom(stats,setNames)
 importFrom(tibble,as_tibble)
 importFrom(tibble,enframe)
+importFrom(tibble,tibble)
 importFrom(utils,URLdecode)
 importFrom(utils,URLencode)
 importFrom(utils,adist)

R/cts.R

@@ -69,7 +69,7 @@ cts_compinfo <- function(inchikey, verbose = TRUE){
 #' @param choices to return only the first result, use 'choices = 1'.  To choose a result from an interative menu, provide a number of choices to choose from or "all".
 #' @param verbose logical; should a verbose output be printed on the console?
 #' @param ... currently not used.
-#' @return a list of characters. If first = TRUE a vector.
+#' @return a list of character vectors or if \code{choices} is used, then a single named vector.
 #' @author Eduard Szoecs, \email{eduardszoecs@@gmail.com}
 #' @details See also \url{http://cts.fiehnlab.ucdavis.edu/}
 #' for possible values of from and to.
@@ -83,19 +83,21 @@ cts_compinfo <- function(inchikey, verbose = TRUE){
 #' @examples
 #' \donttest{
 #' # might fail if API is not available
-#' cts_convert('XEFQLINVKFYRCS-UHFFFAOYSA-N', 'inchikey', 'Chemical Name')
+#' cts_convert("triclosan", "Chemical Name", "inchikey")
 #'
 #' ### multiple inputs
-#' comp <- c('XEFQLINVKFYRCS-UHFFFAOYSA-N', 'BSYNRYMUTXBXSQ-UHFFFAOYSA-N')
-#' cts_convert(comp, 'inchikey', 'Chemical Name')
+#' comp <- c("triclosan", "hexane")
+#' cts_convert(comp, "Chemical Name", "cas")
 #' }
 cts_convert <- function(query, from, to, first = FALSE, choices = NULL, verbose = TRUE, ...){
   if(!missing("first"))
     stop('"first" is deprecated.  Use "choices = 1" instead.')
   if (length(from) > 1 | length(to) > 1) {
-    stop('Cannot handle multiple input strings.')
+    stop('Cannot handle multiple input or output types.  Please provide only one argument for `from` and `to`.')
   }
+
   foo <- function(query, from, to , first, verbose){
+    if (is.na(query)) return(NA)
     baseurl <- "http://cts.fiehnlab.ucdavis.edu/service/convert"
     qurl <- paste0(baseurl, '/', from, '/', to, '/', query)
     qurl <- URLencode(qurl)

R/etox.R

@@ -6,6 +6,7 @@
 #' @import xml2 httr
 #' @importFrom stats rgamma
 #' @importFrom dplyr bind_rows
+#' @importFrom tibble tibble
 #' @param query character; The searchterm
 #' @param from character; Type of input, can be one of "name" (chemical name),
 #' "cas" (CAS Number), "ec" (European Community number for regulatory purposes),
@@ -16,8 +17,7 @@
 #' name) ID, "ask" is a interactive mode and the user is asked for input, "na"
 #' returns \code{NA} if multiple hits are found.
 #' @param verbose logical; print message during processing to console?
-#' @return a dataframe with 4 columns: etoxID, matched substance, string
-#' distance to match and the queried string
+#' @return a tibble with 3 columns: the query, the match, and the etoxID
 #' @note Before using this function, please read the disclaimer
 #' \url{https://webetox.uba.de/webETOX/disclaimer.do}.
 #' @seealso \code{\link{etox_basic}} for basic information,
@@ -57,6 +57,11 @@ get_etoxid <- function(query,
   match <- match.arg(match)
   foo <- function(query, from, match, verbose) {
     on.exit(suppressWarnings(closeAllConnections()))
+
+    if (is.na(query)) {
+      empty <- list(query = NA, match = NA, etoxid = NA)
+      return(empty)
+    }
     if (verbose)
       message("Searching ", query)
     baseurl <- "https://webetox.uba.de/webETOX/public/search/stoff.do"

R/extractors.R

@@ -12,11 +12,7 @@ cas <- function(x, ...){
 # CAS ---------------------------------------------------------------------
 #' @export
 cas.default <- function(x, ...) {
-  sapply(x, function(y) {
-    if (length(y) == 1 && is.na(y))
-      return(NA)
-    y$cas
-    })
+  stop(paste("No cas method for class", class(x)))
 }
 #' @export
 cas.chebi_comp_entity <- function(x, ...) {
@@ -26,15 +22,42 @@ cas.chebi_comp_entity <- function(x, ...) {
   })
 }
 
+#' @export
+cas.opsin_query <- function(x, ...) {
+  stop("CAS is not returned by this datasource!")
+}
+
 #' @export
 cas.pan_query <- function(x, ...) {
   sapply(x, function(y) y$`CAS Number`)
 }
+
+#' @export
+cas.aw_query <- function(x, ...) {
+  sapply(x, function(y) y$cas)
+}
+
 #' @export
 cas.wd_ident <- function(x, ...) {
   x$cas
 }
 
+
+#' @export
+cas.cts_compinfo <- function(x, ...) {
+  stop("CAS is not returned by this data source")
+}
+
+#' @export
+cas.etox_basic <- function(x, ...) {
+  sapply(x, function(y) {
+    if (length(y) == 1 && is.na(y))
+      return(NA)
+    unique(y$cas)
+  })
+}
+
+
 # InChIKey ----------------------------------------------------------------
 #' @rdname extractors
 #' @export
@@ -44,7 +67,7 @@ inchikey <- function(x, ...){
 
 #' @export
 inchikey.default <- function(x, ...) {
-  sapply(x, function(y) y$inchikey)
+  stop(paste("No inchikey method for class", class(x)))
 }
 
 #' @export
@@ -63,14 +86,7 @@ inchikey.chebi_comp_entity <- function(x, ...) {
   })
 }
 
-#' @export
-inchikey.cs_compinfo <- function(x, ...) {
-  x$inchikey
-}
-#' @export
-inchikey.cs_extcompinfo <- function(x, ...) {
-  x$inchikey
-}
+
 #' @export
 inchikey.etox_basic <- function(x, ...) {
   stop("InChIkey is not returned by this datasource!")
@@ -96,6 +112,11 @@ inchikey.wd_ident <- function(x, ...) {
   x$inchikey
 }
 
+#' @export
+inchikey.cts_compinfo <- function(x, ...) {
+  sapply(x, function(x) x$inchikey)
+}
+
 # SMILES ------------------------------------------------------------------
 #' @rdname extractors
 #' @export
@@ -105,7 +126,7 @@ smiles <- function(x, ...){
 
 #' @export
 smiles.default <- function(x, ...) {
-  sapply(x, function(y) y$smiles)
+  stop(paste("no smiles method for class", class(x)))
 }
 #' @export
 smiles.chebi_comp_entity <- function(x, ...) {
@@ -115,14 +136,7 @@ smiles.chebi_comp_entity <- function(x, ...) {
   })
 }
 
-#' @export
-smiles.cs_compinfo <- function(x, ...) {
-  x$smiles
-}
-#' @export
-smiles.cs_extcompinfo <- function(x, ...) {
-  x$smiles
-}
+
 #' @export
 smiles.cts_compinfo <- function(x, ...) {
   stop("SMILES is not returned by this datasource!")

R/opsin.R

@@ -4,11 +4,14 @@
 #' \url{http://opsin.ch.cam.ac.uk/instructions.html}.
 #'
 #' @import jsonlite httr xml2
+#' @import tibble
+#' @importFrom dplyr select everything
+#' @importFrom purrr map_dfr
 #' @importFrom utils URLencode URLdecode
 #' @param query character;  chemical name that should be queryed.
 #' @param verbose logical; should a verbose output be printed on the console?
 #' @param ... currently not used.
-#' @return a data.frame with five columnns: "inchi", "stdinchi", "stdinchikey", "smiles", "message"
+#' @return a tibble with six columnns: "query", inchi", "stdinchi", "stdinchikey", "smiles", "message", and "status"
 #'
 #' @references Lowe, D. M., Corbett, P. T., Murray-Rust, P., & Glen, R. C. (2011).
 #' Chemical Name to Structure: OPSIN, an Open Source Solution. Journal of Chemical Information and Modeling,
@@ -23,34 +26,42 @@
 
 opsin_query <- function(query, verbose = TRUE, ...){
   # query <- 'cyclopropane'
+
   foo <- function(query, verbose){
     on.exit(suppressWarnings(closeAllConnections()))
-    query <- URLencode(query)
+
+    empty <- c(query, rep(NA, 6))
+    names(empty) <- c("query", "inchi", "stdinchi", "stdinchikey", "smiles", "message", "status")
+    empty <- as_tibble(t(empty))
+    if (is.na(query)) {
+      return(empty)
+    }
+    query_u <- URLencode(query)
     baseurl <- "http://opsin.ch.cam.ac.uk/opsin/"
     out <- 'json'
-    qurl <- paste0(baseurl, query, '.', out)
+    qurl <- paste0(baseurl, query_u, '.', out)
     if (verbose)
-      message('Querying ', URLdecode(query))
+      message('Querying ', URLdecode(query_u))
     Sys.sleep( rgamma(1, shape = 5, scale = 1/10))
     h <- try(GET(qurl), silent = TRUE)
     if (inherits(h, "try-error")) {
       warning('Problem with web service encountered... Returning NA.')
-      return(rep(NA, 5))
+      return(empty)
     }
     cont <- content(h, as = 'text')
     if (substr(cont, 1, 14) == '<!DOCTYPE html') {
       cont <- read_html(cont)
       warning(xml_text(xml_find_all(cont, '//h3')), "\nReturning NA.")
-      return(rep(NA, 5))
+      return(empty)
     }
     cont <- fromJSON(cont)
     cont[['cml']] <- NULL
-    cont <- unlist(cont)
+    cont <- c(query = query, unlist(cont))
+    cont <- tibble::as_tibble(t(cont))
     return(cont)
   }
-  out <- sapply(query, foo, verbose = verbose)
-  out <- data.frame(t(out), stringsAsFactors = FALSE)
-  out[['query']] <- rownames(out)
-  class(out) <- c('opsin_query','data.frame')
+  out <- purrr::map_dfr(query, ~foo(.x, verbose = verbose))
+  out <- dplyr::select(out, query, everything())
+  class(out) <- c("opsin_query", class(out))
   return(out)
-}
+}

R/pubchem.R

@@ -375,7 +375,7 @@ pc_prop <- function(cid, properties = NULL, verbose = TRUE, ...) {
 #' @param arg character; optinal arguments like "name_type=word" to match
 #' individual words.
 #' @param ... optional arguments
-#' @return a character vector.
+#' @return a list of character vectors (one per query). If \code{choices} is used, a single named vector is returned instead.
 #'
 #' @references Wang, Y., J. Xiao, T. O. Suzek, et al. 2009 PubChem: A Public
 #' Information System for
@@ -413,6 +413,7 @@ pc_synonyms <- function(query, from = "name", choices = NULL, verbose = TRUE,
   if (!missing("interactive"))
     stop("'interactive' is deprecated. Use 'choices' instead.")
   foo <- function(query, from, verbose, ...) {
+    if (is.na(query)) return(NA)
     prolog <- "https://pubchem.ncbi.nlm.nih.gov/rest/pug"
     input <- paste0("/compound/", from)
     output <- "/synonyms/JSON"

_pkgdown.yml

@@ -1,11 +1,3 @@
-#To preview pkgdown website locally...
-# #Install the rOpenSci theme
-# remotes::install_github("ropensci/rotemplate")
-
-# #Run in your package directory to build the site:
-# template <- list(package = "rotemplate")
-# pkgdown::build_site(override = list(template = template))
-
 url: https://docs.ropensci.org/webchem
 
 reference: