From 08a97bf74101a3c57d7091cdedcaa2fa7b2a0c54 Mon Sep 17 00:00:00 2001 From: andreas Date: Tue, 14 Jul 2020 14:25:54 +0200 Subject: [PATCH 1/7] added cir_img() function --- NAMESPACE | 1 + NEWS.md | 1 + R/cir.R | 234 ++++++++++++++++++++++++++++++++++++++++++++++++- man/cir_img.Rd | 135 ++++++++++++++++++++++++++++ 4 files changed, 370 insertions(+), 1 deletion(-) create mode 100644 man/cir_img.Rd diff --git a/NAMESPACE b/NAMESPACE index 1b566218..26df862d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -37,6 +37,7 @@ export(chebi_comp_entity) export(ci_query) export(cid_compinfo) export(cir) +export(cir_img) export(cir_query) export(cs_check_key) export(cs_compinfo) diff --git a/NEWS.md b/NEWS.md index d3d8efc4..6c5e4cbd 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,7 @@ ## NEW FEATURES +* Download images of substances from Chemical Identifier Resolver (CIR) with `cir_img()` [contributed by @andschar]. * Download images of substances from ChemSpider with `cs_img()` * `find_db()` checks if a query gets a hit in most databases integrated in webchem. Useful for deciding which of several databases to focus on given a set of chemicals. diff --git a/R/cir.R b/R/cir.R index 41b0b81b..f1e3399d 100644 --- a/R/cir.R +++ b/R/cir.R @@ -137,7 +137,7 @@ cir_query <- function(identifier, representation = "smiles", if (verbose) message(qurl) Sys.sleep(1.5) - h <- try(GET(qurl, timeout(5))) + h <- try(RETRY("GET", qurl)) if (inherits(h, "try-error")) { warning('Problem with web service encountered... Returning NA.') return(NA) @@ -167,3 +167,235 @@ cir_query <- function(identifier, representation = "smiles", out <- setNames(out, identifier) return(out) } + +#' Query Chemical Identifier Resolver Images +#' +#' A interface to the Chemical Identifier Resolver (CIR). +#' (\url{http://cactus.nci.nih.gov/chemical/structure_documentation}). +#' +#' @param query character; Search term. Can be any common chemical identifier +#' (e.g. CAS, INCHI(KEY), SMILES etc.) +#' @param dir character; Directory to save the image. +#' @param format character; Format of the stored image. Can be on of TODO +#' @param format character; Output format of the image. Can be one of "png", +#' "gif". +#' @param width integer; Width of the image. +#' @param height integer; Height of the image. +#' @param linewidth integer; Width of lines. +#' @param symbolfontsize integer; Fontsize of atoms in the image. +#' @param bgcolor character; E.g. transparent, white, \%23AADDEE +#' @param antialiasing logical; Should antialiasing be used? +#' @param atomcolor character; Color of the atoms in the image. +#' @param bondcolor character; Color of the atom bond lines. +#' @param csymbol character; Can be one of "special" (default - i.e. only +#' hydrogen atoms in functional groups or defining stereochemistry) or "all". +#' @param hsymbol character; Can be one of "special" (default - i.e. none are +#' shown) or "all" (all are printed). +#' @param hcolor character; Color of the hydrogen atoms. +#' @param header character; Should a header text be added to the image? Can be +#' any string. +#' @param footer character; Should a footer text be added to the image? Can be +#' any string. +#' @param verbose logical; Should a verbose output be printed on the console? +#' @param frame integer; Should a frame be plotted? Can be on of NULL (default) +#' or 1. +#' @param ... currently not used. +#' +#' @return data.frame and image written to disk +#' @details +#' CIR can resolve can be of the following \code{identifier}: Chemical Names, +#' IUPAC names, +#' CAS Numbers, SMILES strings, IUPAC InChI/InChIKeys, NCI/CADD Identifiers, +#' CACTVS HASHISY, NSC number, PubChem SID, ZINC Code, ChemSpider ID, +#' ChemNavigator SID, eMolecule VID. +#' +#' For an image with transparent background use ‘transparent’ as color name and +#' switch off antialiasing (i.e. antialiasing = 0). +#' +# followed this blog post +# https://cactus.nci.nih.gov/blog/?p=136 +#' +#' @note You can only make 1 request per second (this is a hard-coded feature). +#' +#' @references +#' \code{cir} relies on the great CIR web service created by the CADD +#' Group at NCI/NIH! \cr +#' \url{http://cactus.nci.nih.gov/chemical/structure_documentation}, \cr +#' \url{http://cactus.nci.nih.gov/blog/?cat=10}, \cr +#' \url{http://cactus.nci.nih.gov/blog/?p=1386}, \cr +#' \url{http://cactus.nci.nih.gov/blog/?p=1456}, \cr +#' +#' @author Andreas Scharmueller, \email{andschar@@protonmail.com} +#' +#' @examples +#' \donttest{ +#' # might fail if API is not available +#' cir_img("CCO", dir = tempdir()) # SMILES +#' +#' # multiple query strings and different formats +#' query = c("Glyphosate", "Isoproturon", "BSYNRYMUTXBXSQ-UHFFFAOYSA-N") +#' cir_img(query, dir = tempdir(), bgcolor = "transparent", antialising = 0) +#' +#' # all parameters +#' query = "Triclosan" +#' cir_img(query, +#' dir = tempdir(), +#' format = "gif", +#' width = 600, +#' height = 600, +#' linewidth = 5, +#' symbolfontsize = 30, +#' bgcolor = "red", +#' antialising = FALSE, +#' atomcolor = "green", +#' bondcolor = "yellow", +#' csymbol = "all", +#' hsymbol = "all", +#' hcolor = "purple", +#' header = "My funky chemical structure..", +#' footer = "..is just so awesome!", +#' frame = 1) +#'} +#' @export +#' +cir_img <- function(query, + dir = NULL, + format = c("png", "gif"), + width = 500, + height = 500, + linewidth = 2, + symbolfontsize = 16, + bgcolor = NULL, + antialiasing = TRUE, + atomcolor = NULL, + bondcolor = NULL, + csymbol = c("special", "all"), + hsymbol = c("special", "all"), + hcolor = NULL, + header = NULL, + footer = NULL, + frame = NULL, + verbose = TRUE, + ...) { + # check + if (is.null(dir)) + stop('Please provide a directory (dir =) to save the images.') + format <- match.arg(format) + csymbol <- match.arg(csymbol, c("special", "all")) + hsymbol <- match.arg(hsymbol, c("special", "all")) + foo <- function(query, + dir, + format, + width, + height, + linewidth, + symbolfontsize, + bgcolor, + antialiasing, + atomcolor, + bondcolor, + csymbol, + hsymbol, + hcolor, + header, + footer, + frame, + verbose, + ...) { + # prolog + baseurl <- "https://cactus.nci.nih.gov/chemical/structure" + qurl <- paste(baseurl, query, "image", sep = "/") + # options + if (!is.null(format)) + format <- paste0("format=", format) + if (!is.null(width)) + width <- paste0("width=", width) + if (!is.null(height)) + height <- paste0("height=", height) + if (!is.null(linewidth)) + linewidth <- paste0("linewidth=", linewidth) + if (!is.null(symbolfontsize)) + symbolfontsize <- paste0("symbolfontsize=", symbolfontsize) + if (!is.null(bgcolor)) + bgcolor <- paste0("bgcolor=", bgcolor) + if (!is.null(antialiasing)) + antialiasing <- paste0("antialiasing=", as.numeric(antialiasing)) + if (!is.null(atomcolor)) + atomcolor <- paste0("atomcolor=", atomcolor) + if (!is.null(bondcolor)) + bondcolor <- paste0("bondcolor=", bondcolor) + if (!is.null(csymbol)) + csymbol <- paste0("csymbol=", csymbol) + if (!is.null(hsymbol)) + hsymbol <- paste0("hsymbol=", hsymbol) + if (!is.null(hcolor)) + hcolor <- paste0("hcolor=", hcolor) + if (!is.null(header)) + header <- paste0("header=\"", header, "\"") + if (!is.null(footer)) + footer <- paste0("footer=\"", footer, "\"") + if (!is.null(frame)) + frame <- paste0("frame=", frame) + opts <- c(format, + width, + height, + linewidth, + symbolfontsize, + bgcolor, + antialiasing, + atomcolor, + bondcolor, + csymbol, + hsymbol, + hcolor, + header, + footer, + frame) + opts <- paste0(opts, collapse = "&") + opts <- paste0("?", opts) + # url + qurl <- URLencode(paste0(qurl, opts)) + # query + if (verbose) + message("Querying: ", query, "\n", qurl) + Sys.sleep(1.5) + path <- file.path(dir, paste0(query, ".", sub('format=', '', format))) + message("Image saved under: ", path) + # return image + h <- try( + RETRY("GET", + qurl, + write_disk(path, overwrite = TRUE)) + ) + if (inherits(h, "try-error")) { + warning("Problem with web service encountered... Returning NA.") + return(data.frame(query = query, stringsAsFactors = FALSE)) + } else { + # return paths data.frame + data.frame(query = query, + path = path, + url = qurl, + stringsAsFactors = FALSE) + } + } + out <- lapply(query, + foo, + dir = dir, + format = format, + width = width, + height = height, + linewidth = linewidth, + symbolfontsize = symbolfontsize, + bgcolor = bgcolor, + antialiasing = antialiasing, + atomcolor = atomcolor, + bondcolor = bondcolor, + csymbol = csymbol, + hsymbol = hsymbol, + hcolor = hcolor, + header = header, + footer = footer, + frame = frame, + verbose = verbose) + dplyr::bind_rows(out) +} diff --git a/man/cir_img.Rd b/man/cir_img.Rd new file mode 100644 index 00000000..eeb4dae7 --- /dev/null +++ b/man/cir_img.Rd @@ -0,0 +1,135 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cir.R +\name{cir_img} +\alias{cir_img} +\title{Query Chemical Identifier Resolver Images} +\usage{ +cir_img( + query, + dir = NULL, + format = c("png", "gif"), + width = 500, + height = 500, + linewidth = 2, + symbolfontsize = 16, + bgcolor = NULL, + antialiasing = TRUE, + atomcolor = NULL, + bondcolor = NULL, + csymbol = c("special", "all"), + hsymbol = c("special", "all"), + hcolor = NULL, + header = NULL, + footer = NULL, + frame = NULL, + verbose = TRUE, + ... +) +} +\arguments{ +\item{query}{character; Search term. Can be any common chemical identifier +(e.g. CAS, INCHI(KEY), SMILES etc.)} + +\item{dir}{character; Directory to save the image.} + +\item{format}{character; Output format of the image. Can be one of "png", +"gif".} + +\item{width}{integer; Width of the image.} + +\item{height}{integer; Height of the image.} + +\item{linewidth}{integer; Width of lines.} + +\item{symbolfontsize}{integer; Fontsize of atoms in the image.} + +\item{bgcolor}{character; E.g. transparent, white, \%23AADDEE} + +\item{antialiasing}{logical; Should antialiasing be used?} + +\item{atomcolor}{character; Color of the atoms in the image.} + +\item{bondcolor}{character; Color of the atom bond lines.} + +\item{csymbol}{character; Can be one of "special" (default - i.e. only +hydrogen atoms in functional groups or defining stereochemistry) or "all".} + +\item{hsymbol}{character; Can be one of "special" (default - i.e. none are +shown) or "all" (all are printed).} + +\item{hcolor}{character; Color of the hydrogen atoms.} + +\item{header}{character; Should a header text be added to the image? Can be +any string.} + +\item{footer}{character; Should a footer text be added to the image? Can be +any string.} + +\item{frame}{integer; Should a frame be plotted? Can be on of NULL (default) +or 1.} + +\item{verbose}{logical; Should a verbose output be printed on the console?} + +\item{...}{currently not used.} +} +\value{ +data.frame and image written to disk +} +\description{ +A interface to the Chemical Identifier Resolver (CIR). + (\url{http://cactus.nci.nih.gov/chemical/structure_documentation}). +} +\details{ +CIR can resolve can be of the following \code{identifier}: Chemical Names, + IUPAC names, + CAS Numbers, SMILES strings, IUPAC InChI/InChIKeys, NCI/CADD Identifiers, + CACTVS HASHISY, NSC number, PubChem SID, ZINC Code, ChemSpider ID, + ChemNavigator SID, eMolecule VID. + + For an image with transparent background use ‘transparent’ as color name and + switch off antialiasing (i.e. antialiasing = 0). +} +\note{ +You can only make 1 request per second (this is a hard-coded feature). +} +\examples{ +\donttest{ +# might fail if API is not available +cir_img("CCO", dir = tempdir()) # SMILES + +# multiple query strings and different formats +query = c("Glyphosate", "Isoproturon", "BSYNRYMUTXBXSQ-UHFFFAOYSA-N") +cir_img(query, dir = tempdir(), bgcolor = "transparent", antialising = 0) + +# all parameters +query = "Triclosan" +cir_img(query, + dir = tempdir(), + format = "gif", + width = 600, + height = 600, + linewidth = 5, + symbolfontsize = 30, + bgcolor = "red", + antialising = FALSE, + atomcolor = "green", + bondcolor = "yellow", + csymbol = "all", + hsymbol = "all", + hcolor = "purple", + header = "My funky chemical structure..", + footer = "..is just so awesome!", + frame = 1) +} +} +\references{ +\code{cir} relies on the great CIR web service created by the CADD +Group at NCI/NIH! \cr +\url{http://cactus.nci.nih.gov/chemical/structure_documentation}, \cr +\url{http://cactus.nci.nih.gov/blog/?cat=10}, \cr +\url{http://cactus.nci.nih.gov/blog/?p=1386}, \cr +\url{http://cactus.nci.nih.gov/blog/?p=1456}, \cr +} +\author{ +Andreas Scharmueller, \email{andschar@protonmail.com} +} From b988a2b6a2aa8623edacf060ff42128b18a072fe Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andreas=20Scharm=C3=BCller?= Date: Thu, 16 Jul 2020 17:23:03 +0200 Subject: [PATCH 2/7] Update R/cir.R Co-authored-by: Eric R Scott --- R/cir.R | 69 ++++++++++++++++++--------------------------------------- 1 file changed, 22 insertions(+), 47 deletions(-) diff --git a/R/cir.R b/R/cir.R index f1e3399d..9330d518 100644 --- a/R/cir.R +++ b/R/cir.R @@ -306,53 +306,28 @@ cir_img <- function(query, baseurl <- "https://cactus.nci.nih.gov/chemical/structure" qurl <- paste(baseurl, query, "image", sep = "/") # options - if (!is.null(format)) - format <- paste0("format=", format) - if (!is.null(width)) - width <- paste0("width=", width) - if (!is.null(height)) - height <- paste0("height=", height) - if (!is.null(linewidth)) - linewidth <- paste0("linewidth=", linewidth) - if (!is.null(symbolfontsize)) - symbolfontsize <- paste0("symbolfontsize=", symbolfontsize) - if (!is.null(bgcolor)) - bgcolor <- paste0("bgcolor=", bgcolor) - if (!is.null(antialiasing)) - antialiasing <- paste0("antialiasing=", as.numeric(antialiasing)) - if (!is.null(atomcolor)) - atomcolor <- paste0("atomcolor=", atomcolor) - if (!is.null(bondcolor)) - bondcolor <- paste0("bondcolor=", bondcolor) - if (!is.null(csymbol)) - csymbol <- paste0("csymbol=", csymbol) - if (!is.null(hsymbol)) - hsymbol <- paste0("hsymbol=", hsymbol) - if (!is.null(hcolor)) - hcolor <- paste0("hcolor=", hcolor) - if (!is.null(header)) - header <- paste0("header=\"", header, "\"") - if (!is.null(footer)) - footer <- paste0("footer=\"", footer, "\"") - if (!is.null(frame)) - frame <- paste0("frame=", frame) - opts <- c(format, - width, - height, - linewidth, - symbolfontsize, - bgcolor, - antialiasing, - atomcolor, - bondcolor, - csymbol, - hsymbol, - hcolor, - header, - footer, - frame) - opts <- paste0(opts, collapse = "&") - opts <- paste0("?", opts) + opts <- + c( + format = format, + width = width, + height = height, + linewidth = linewidth, + symbolfontsize = symbolfontsize, + bgcolor = bgcolor, + antialiasing = as.numeric(antialiasing), + atomcolor = atomcolor, + bondcolor = bondcolor, + csymbol = csymbol, + hsymbol = hsymbol, + hcolor = hcolor, + header = header, + footer = footer, + frame = frame + ) + +opts <- paste0(names(opts), "=", opts) +opts <- paste0(opts, collapse = "&") +opts <- paste0("?", opts) # url qurl <- URLencode(paste0(qurl, opts)) # query From ade024066dd7aca19131383885d4d8d0adca9946 Mon Sep 17 00:00:00 2001 From: andreas Date: Mon, 27 Jul 2020 16:30:36 +0200 Subject: [PATCH 3/7] cir_img update + tests --- R/cir.R | 151 ++++++++++++++++++++++---------------- man/cir_img.Rd | 7 +- tests/testthat/test-cir.R | 12 +++ 3 files changed, 103 insertions(+), 67 deletions(-) diff --git a/R/cir.R b/R/cir.R index 9330d518..61765e38 100644 --- a/R/cir.R +++ b/R/cir.R @@ -201,7 +201,7 @@ cir_query <- function(identifier, representation = "smiles", #' or 1. #' @param ... currently not used. #' -#' @return data.frame and image written to disk +#' @return image written to disk #' @details #' CIR can resolve can be of the following \code{identifier}: Chemical Names, #' IUPAC names, @@ -246,7 +246,7 @@ cir_query <- function(identifier, representation = "smiles", #' linewidth = 5, #' symbolfontsize = 30, #' bgcolor = "red", -#' antialising = FALSE, +#' antialiasing = FALSE, #' atomcolor = "green", #' bondcolor = "yellow", #' csymbol = "all", @@ -254,7 +254,8 @@ cir_query <- function(identifier, representation = "smiles", #' hcolor = "purple", #' header = "My funky chemical structure..", #' footer = "..is just so awesome!", -#' frame = 1) +#' frame = 1, +#' verbose = TRUE) #'} #' @export #' @@ -306,71 +307,93 @@ cir_img <- function(query, baseurl <- "https://cactus.nci.nih.gov/chemical/structure" qurl <- paste(baseurl, query, "image", sep = "/") # options - opts <- - c( - format = format, - width = width, - height = height, - linewidth = linewidth, - symbolfontsize = symbolfontsize, - bgcolor = bgcolor, - antialiasing = as.numeric(antialiasing), - atomcolor = atomcolor, - bondcolor = bondcolor, - csymbol = csymbol, - hsymbol = hsymbol, - hcolor = hcolor, - header = header, - footer = footer, - frame = frame - ) - -opts <- paste0(names(opts), "=", opts) -opts <- paste0(opts, collapse = "&") -opts <- paste0("?", opts) + if (!is.null(format)) + format <- paste0("format=", format) + if (!is.null(width)) + width <- paste0("width=", width) + if (!is.null(height)) + height <- paste0("height=", height) + if (!is.null(linewidth)) + linewidth <- paste0("linewidth=", linewidth) + if (!is.null(symbolfontsize)) + symbolfontsize <- paste0("symbolfontsize=", symbolfontsize) + if (!is.null(bgcolor)) + bgcolor <- paste0("bgcolor=", bgcolor) + if (!is.null(antialiasing)) + antialiasing <- paste0("antialiasing=", as.numeric(antialiasing)) + if (!is.null(atomcolor)) + atomcolor <- paste0("atomcolor=", atomcolor) + if (!is.null(bondcolor)) + bondcolor <- paste0("bondcolor=", bondcolor) + if (!is.null(csymbol)) + csymbol <- paste0("csymbol=", csymbol) + if (!is.null(hsymbol)) + hsymbol <- paste0("hsymbol=", hsymbol) + if (!is.null(hcolor)) + hcolor <- paste0("hcolor=", hcolor) + if (!is.null(header)) + header <- paste0("header=\"", header, "\"") + if (!is.null(footer)) + footer <- paste0("footer=\"", footer, "\"") + if (!is.null(frame)) + frame <- paste0("frame=", frame) + opts <- c(format, + width, + height, + linewidth, + symbolfontsize, + bgcolor, + antialiasing, + atomcolor, + bondcolor, + csymbol, + hsymbol, + hcolor, + header, + footer, + frame) + opts <- paste0(opts, collapse = "&") + opts <- paste0("?", opts) # url qurl <- URLencode(paste0(qurl, opts)) + path <- file.path(dir, paste0(query, ".", sub('format=', '', format))) # query + Sys.sleep(1) if (verbose) - message("Querying: ", query, "\n", qurl) - Sys.sleep(1.5) - path <- file.path(dir, paste0(query, ".", sub('format=', '', format))) - message("Image saved under: ", path) - # return image - h <- try( - RETRY("GET", - qurl, - write_disk(path, overwrite = TRUE)) - ) - if (inherits(h, "try-error")) { - warning("Problem with web service encountered... Returning NA.") - return(data.frame(query = query, stringsAsFactors = FALSE)) - } else { - # return paths data.frame - data.frame(query = query, - path = path, - url = qurl, - stringsAsFactors = FALSE) + message(paste0("Querying ", query, ". "), appendLF = TRUE) + res <- httr::RETRY("GET", + qurl, + quiet = TRUE, + terminate_on = 404, + httr::write_disk(path, overwrite = TRUE)) + if (verbose) { + message(httr::message_for_status(res)) + if (httr::status_code(res) == 404) { + file.remove(path) + } else { + message("Image saved under: ", path) + } } } - out <- lapply(query, - foo, - dir = dir, - format = format, - width = width, - height = height, - linewidth = linewidth, - symbolfontsize = symbolfontsize, - bgcolor = bgcolor, - antialiasing = antialiasing, - atomcolor = atomcolor, - bondcolor = bondcolor, - csymbol = csymbol, - hsymbol = hsymbol, - hcolor = hcolor, - header = header, - footer = footer, - frame = frame, - verbose = verbose) - dplyr::bind_rows(out) + invisible( + lapply(query, + foo, + dir = dir, + format = format, + width = width, + height = height, + linewidth = linewidth, + symbolfontsize = symbolfontsize, + bgcolor = bgcolor, + antialiasing = antialiasing, + atomcolor = atomcolor, + bondcolor = bondcolor, + csymbol = csymbol, + hsymbol = hsymbol, + hcolor = hcolor, + header = header, + footer = footer, + frame = frame, + verbose = verbose) + ) } diff --git a/man/cir_img.Rd b/man/cir_img.Rd index eeb4dae7..dedd9de3 100644 --- a/man/cir_img.Rd +++ b/man/cir_img.Rd @@ -73,7 +73,7 @@ or 1.} \item{...}{currently not used.} } \value{ -data.frame and image written to disk +image written to disk } \description{ A interface to the Chemical Identifier Resolver (CIR). @@ -111,7 +111,7 @@ cir_img(query, linewidth = 5, symbolfontsize = 30, bgcolor = "red", - antialising = FALSE, + antialiasing = FALSE, atomcolor = "green", bondcolor = "yellow", csymbol = "all", @@ -119,7 +119,8 @@ cir_img(query, hcolor = "purple", header = "My funky chemical structure..", footer = "..is just so awesome!", - frame = 1) + frame = 1, + verbose = TRUE) } } \references{ diff --git a/tests/testthat/test-cir.R b/tests/testthat/test-cir.R index d0b8ee4d..71c7c7ab 100644 --- a/tests/testthat/test-cir.R +++ b/tests/testthat/test-cir.R @@ -31,3 +31,15 @@ test_that("cir_query() handles special characters in SMILES", { expect_equal(cir_query("C#C", representation = "inchikey")[[1]], "InChIKey=HSFWRNGVRCDJHI-UHFFFAOYNA-N") }) + +test_that("cir_img()", { + skip_on_cran() + skip_if_not(up, "CIR server is down") + + expect_true(is.null(cir_img('CCO', tempdir())[[1]])) + fl <- file.path(tempdir(), 'CCO.png') + expect_true(file.exists(fl)) + fl2 <- file.path(tempdir(), 'abcdefghijk.png') + cir_img('abcdefghijk', tempdir()) + expect_true(!file.exists(fl2)) +}) From 2537c00e1e27e30aca352c35ed09244ba8f05f0a Mon Sep 17 00:00:00 2001 From: andreas Date: Mon, 27 Jul 2020 20:51:38 +0200 Subject: [PATCH 4/7] polishing --- R/cir.R | 52 +++++++++++++++++++-------------------- man/cir_img.Rd | 2 +- tests/testthat/test-cir.R | 2 +- 3 files changed, 28 insertions(+), 28 deletions(-) diff --git a/R/cir.R b/R/cir.R index 61765e38..3e9e685c 100644 --- a/R/cir.R +++ b/R/cir.R @@ -240,7 +240,7 @@ cir_query <- function(identifier, representation = "smiles", #' query = "Triclosan" #' cir_img(query, #' dir = tempdir(), -#' format = "gif", +#' format = "png", #' width = 600, #' height = 600, #' linewidth = 5, @@ -280,7 +280,7 @@ cir_img <- function(query, ...) { # check if (is.null(dir)) - stop('Please provide a directory (dir =) to save the images.') + stop("Please provide a directory (dir =) to save the images.") format <- match.arg(format) csymbol <- match.arg(csymbol, c("special", "all")) hsymbol <- match.arg(hsymbol, c("special", "all")) @@ -356,44 +356,44 @@ cir_img <- function(query, opts <- paste0("?", opts) # url qurl <- URLencode(paste0(qurl, opts)) - path <- file.path(dir, paste0(query, ".", sub('format=', '', format))) + path <- file.path(dir, paste0(query, ".", sub("format=", "", format))) # query Sys.sleep(1) if (verbose) - message(paste0("Querying ", query, ". "), appendLF = TRUE) + message(paste0("Querying ", query, ". "), appendLF = FALSE) res <- httr::RETRY("GET", qurl, quiet = TRUE, terminate_on = 404, httr::write_disk(path, overwrite = TRUE)) if (verbose) { - message(httr::message_for_status(res)) + message(httr::message_for_status(res), " ", appendLF = FALSE) if (httr::status_code(res) == 404) { file.remove(path) + message("No image saved.") } else { message("Image saved under: ", path) } } } - invisible( - lapply(query, - foo, - dir = dir, - format = format, - width = width, - height = height, - linewidth = linewidth, - symbolfontsize = symbolfontsize, - bgcolor = bgcolor, - antialiasing = antialiasing, - atomcolor = atomcolor, - bondcolor = bondcolor, - csymbol = csymbol, - hsymbol = hsymbol, - hcolor = hcolor, - header = header, - footer = footer, - frame = frame, - verbose = verbose) - ) + for (i in query) { + foo(query = i, + dir = dir, + format = format, + width = width, + height = height, + linewidth = linewidth, + symbolfontsize = symbolfontsize, + bgcolor = bgcolor, + antialiasing = antialiasing, + atomcolor = atomcolor, + bondcolor = bondcolor, + csymbol = csymbol, + hsymbol = hsymbol, + hcolor = hcolor, + header = header, + footer = footer, + frame = frame, + verbose = verbose) + } } diff --git a/man/cir_img.Rd b/man/cir_img.Rd index dedd9de3..9b49da86 100644 --- a/man/cir_img.Rd +++ b/man/cir_img.Rd @@ -105,7 +105,7 @@ cir_img(query, dir = tempdir(), bgcolor = "transparent", antialising = 0) query = "Triclosan" cir_img(query, dir = tempdir(), - format = "gif", + format = "png", width = 600, height = 600, linewidth = 5, diff --git a/tests/testthat/test-cir.R b/tests/testthat/test-cir.R index 71c7c7ab..7b93a7cc 100644 --- a/tests/testthat/test-cir.R +++ b/tests/testthat/test-cir.R @@ -36,7 +36,7 @@ test_that("cir_img()", { skip_on_cran() skip_if_not(up, "CIR server is down") - expect_true(is.null(cir_img('CCO', tempdir())[[1]])) + expect_true(is.null(cir_img('CCO', tempdir()))) fl <- file.path(tempdir(), 'CCO.png') expect_true(file.exists(fl)) fl2 <- file.path(tempdir(), 'abcdefghijk.png') From 3ceca27f5163dfec5afe2c58c917eb6c31e8c48e Mon Sep 17 00:00:00 2001 From: andreas Date: Tue, 28 Jul 2020 09:11:17 +0200 Subject: [PATCH 5/7] update error handling --- R/cir.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/cir.R b/R/cir.R index 3e9e685c..9364df17 100644 --- a/R/cir.R +++ b/R/cir.R @@ -368,7 +368,7 @@ cir_img <- function(query, httr::write_disk(path, overwrite = TRUE)) if (verbose) { message(httr::message_for_status(res), " ", appendLF = FALSE) - if (httr::status_code(res) == 404) { + if (httr::http_error(res) && file.exists(path)) { file.remove(path) message("No image saved.") } else { From 318f71907e41b3816072c7d02635f515287a7757 Mon Sep 17 00:00:00 2001 From: andreas Date: Fri, 14 Aug 2020 17:44:31 +0200 Subject: [PATCH 6/7] empty sting NA clause --- R/cir.R | 7 ++++--- man/cir_img.Rd | 2 +- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/R/cir.R b/R/cir.R index 9364df17..9d58d127 100644 --- a/R/cir.R +++ b/R/cir.R @@ -260,7 +260,7 @@ cir_query <- function(identifier, representation = "smiles", #' @export #' cir_img <- function(query, - dir = NULL, + dir, format = c("png", "gif"), width = 500, height = 500, @@ -279,8 +279,9 @@ cir_img <- function(query, verbose = TRUE, ...) { # check - if (is.null(dir)) - stop("Please provide a directory (dir =) to save the images.") + if (anyNA(query) || any(query == '')) { + stop('NA or empty string provided.') + } format <- match.arg(format) csymbol <- match.arg(csymbol, c("special", "all")) hsymbol <- match.arg(hsymbol, c("special", "all")) diff --git a/man/cir_img.Rd b/man/cir_img.Rd index 9b49da86..c2f79c6a 100644 --- a/man/cir_img.Rd +++ b/man/cir_img.Rd @@ -6,7 +6,7 @@ \usage{ cir_img( query, - dir = NULL, + dir, format = c("png", "gif"), width = 500, height = 500, From 6dee9c9f0e2175c28926da5c11c38679b1e63ffc Mon Sep 17 00:00:00 2001 From: andreas Date: Thu, 20 Aug 2020 11:27:17 +0200 Subject: [PATCH 7/7] Na directory --- R/cir.R | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/R/cir.R b/R/cir.R index 9d58d127..0cda4e47 100644 --- a/R/cir.R +++ b/R/cir.R @@ -278,9 +278,8 @@ cir_img <- function(query, frame = NULL, verbose = TRUE, ...) { - # check - if (anyNA(query) || any(query == '')) { - stop('NA or empty string provided.') + if (is.na(dir) || !dir.exists(dir)) { + stop('Directory does not exist.') } format <- match.arg(format) csymbol <- match.arg(csymbol, c("special", "all")) @@ -304,6 +303,11 @@ cir_img <- function(query, frame, verbose, ...) { + # check + if (is.na(query) || query == '') { + message('NA or empty string provided. Query skipped.') + return(NULL) + } # prolog baseurl <- "https://cactus.nci.nih.gov/chemical/structure" qurl <- paste(baseurl, query, "image", sep = "/")