Merge pull request #229 from andschar/master

fixed etox_basic. closes #227
ropensci · Mar 26, 2020 · 434cd60 · 434cd60
2 parents 5170f7d + 762ce2f
commit 434cd60
Show file tree

Hide file tree

Showing 2 changed files with 45 additions and 19 deletions.
diff --git a/R/etox.R b/R/etox.R
@@ -161,7 +161,7 @@ get_etoxid <- function(query,
 #' id <- get_etoxid('Triclosan', match = 'best')
 #' etox_basic(id$etoxid)
 #'
-#' # Retrieve CAS for multiple inputs
+#' # Retrieve data for multiple inputs
 #' ids <- c("20179", "9051")
 #' out <- etox_basic(ids)
 #' out
@@ -179,7 +179,6 @@ etox_basic <- function(id, verbose = TRUE) {
       message('ID is NA! Returning NA.\n')
       return(NA)
     }
-    # id <- '20179'
     baseurl <- 'https://webetox.uba.de/webETOX/public/basics/stoff.do?language=en&id='
     qurl <- paste0(baseurl, id)
     if (verbose)
@@ -190,10 +189,14 @@ etox_basic <- function(id, verbose = TRUE) {
       message('ID not found! Returning NA.\n')
       return(NA)
     }
-    tabs <- html_table(tt, fill = TRUE)
+    tabs <- try(suppressWarnings(html_table(tt, fill = TRUE)), silent = TRUE)
+    if (inherits(tabs, 'try-error')) {
+      message('ID found. No data available. Returning NA.\n')
+      return(NA)
+    }
     binf <- tabs[[length(tabs)]]
     cas <- binf[, 1][binf[, 2] == 'CAS']
-    ec <- binf[, 1][grepl('EINEC', binf[, 2])]
+    ec <- binf[, 1][grepl('^EC$|EINEC', binf[, 2])]
     gsbl <- binf[, 1][binf[, 2] == 'GSBL']
 
     syns <- tabs[[2]][c(1, 3, 4)]
@@ -206,8 +209,36 @@ etox_basic <- function(id, verbose = TRUE) {
     out <- list(cas = cas, ec = ec, gsbl = gsbl, synonyms = syns,
                 source_url = qurl)
     return(out)
+
+    # CODE FOR A POSSIBLE FUTURE RELEASE
+    # binf <- tabs[[length(tabs)]]
+    # cas <- binf[, 1][binf[, 2] == 'CAS']
+    # ec <- binf[, 1][grepl('^EC$|EINEC', binf[, 2])]
+    # gsbl <- binf[, 1][binf[, 2] == 'GSBL']
+    #
+    # syns <- tabs[[2]][c(1, 3, 4)]
+    # names(syns) <- tolower(gsub('\\s+', '_', names(syns)))
+    # group <- tolower(syns[ syns$substance_name_typ == 'GROUP_USE' &
+    #                          syns$language == 'English', ]$notation)
+    # syn <- syns[ syns$substance_name_typ == 'SYNONYM', ]
+    # syn <- syn[ ,-2]
+    # names(syn) <- c('name', 'language')
+    # # return list of data.frames
+    # l <- list(cas = cas,
+    #           ec = ec,
+    #           gsbl = gsbl,
+    #           source_url = qurl)
+    # data <- as.data.frame(t(do.call(rbind, l)),
+    #                       stringsAsFactors = FALSE)
+    # chem_group <- as.data.frame(t(group), stringsAsFactors = FALSE)
+    # names(chem_group) <- chem_group[1, ]
+    # chem_group[1, ] <- TRUE
+    # out <- list(data = data,
+    #             chemical_group = chem_group,
+    #             synonyms = syn)
+    ### END
   }
-  out <- lapply(id, foo,verbose = verbose)
+  out <- lapply(id, foo, verbose = verbose)
   out <- setNames(out, id)
   class(out) <- c('etox_basic','list')
   return(out)

diff --git a/R/extractors.R b/R/extractors.R
@@ -9,6 +9,7 @@ cas <- function(x, ...){
   UseMethod("cas")
 }
 
+# CAS ---------------------------------------------------------------------
 #' @export
 cas.default <- function(x, ...) {
   sapply(x, function(y) {
@@ -17,7 +18,6 @@ cas.default <- function(x, ...) {
     y$cas
     })
 }
-
 #' @export
 cas.chebi_comp_entity <- function(x, ...) {
   sapply(x, function(y) {
@@ -30,12 +30,19 @@ cas.chebi_comp_entity <- function(x, ...) {
 cas.pan_query <- function(x, ...) {
   sapply(x, function(y) y$`CAS Number`)
 }
-
 #' @export
 cas.wd_ident <- function(x, ...) {
   x$cas
 }
 
+cas.etox_basic <- function(x, ...) {
+  sapply(x, function(y) {
+    if (length(y) == 1 && is.na(y))
+      return(NA)
+    unique(y[[1]]$cas)
+  })
+}
+
 # InChIKey ----------------------------------------------------------------
 #' @rdname extractors
 #' @export
@@ -68,12 +75,10 @@ inchikey.chebi_comp_entity <- function(x, ...) {
 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!")
@@ -87,15 +92,13 @@ inchikey.pan_query <- function(x, ...) {
 inchikey.opsin_query <- function(x, ...) {
   x$stdinchikey
 }
-
 #' @export
 inchikey.pc_prop <- function(x, ...) {
   if (!"InChIKey" %in% names(x)) {
     stop("InChIKey not queried!")
   }
   x$InChIKey
 }
-
 #' @export
 inchikey.wd_ident <- function(x, ...) {
   x$inchikey
@@ -112,7 +115,6 @@ smiles <- function(x, ...){
 smiles.default <- function(x, ...) {
   sapply(x, function(y) y$smiles)
 }
-
 #' @export
 smiles.chebi_comp_entity <- function(x, ...) {
   sapply(x, function(y) {
@@ -125,18 +127,14 @@ smiles.chebi_comp_entity <- function(x, ...) {
 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!")
 }
-
 #' @export
 smiles.etox_basic <- function(x, ...) {
   stop("InChIkey is not returned by this datasource!")
@@ -145,7 +143,6 @@ smiles.etox_basic <- function(x, ...) {
 smiles.pan_query <- function(x, ...) {
   stop("SMILES is not returned by this datasource!")
 }
-
 #' @export
 smiles.opsin_query <- function(x, ...) {
   x$smiles
@@ -154,15 +151,13 @@ smiles.opsin_query <- function(x, ...) {
 smiles.aw_query <- function(x, ...) {
   stop("SMILES is not returned by this datasource!")
 }
-
 #' @export
 smiles.pc_prop <- function(x, ...) {
   if (!"CanonicalSMILES" %in% names(x)) {
     stop("CanonicalSMILES not queried!")
   }
   x$CanonicalSMILES
 }
-
 #' @export
 smiles.wd_ident <- function(x, ...) {
   x$smiles