diff options
Diffstat (limited to 'R')
-rw-r--r-- | R/chent.R | 589 | ||||
-rw-r--r-- | R/zzz.R | 9 |
2 files changed, 402 insertions, 196 deletions
@@ -1,74 +1,102 @@ -# Copyright (C) 2016-2019 Johannes Ranke -# Contact: jranke@uni-bremen.de -# This file is part of the R package chents - -# This program is free software: you can redistribute it and/or modify it under -# the terms of the GNU General Public License as published by the Free Software -# Foundation, either version 3 of the License, or (at your option) any later -# version. - -# This program is distributed in the hope that it will be useful, but WITHOUT -# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS -# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more -# details. - -# You should have received a copy of the GNU General Public License along with -# this program. If not, see <http://www.gnu.org/licenses/> - -#' An R6 class for chemical entities with associated data +#' @title An R6 class for chemical entities with associated data #' -#' The class is initialised with an identifier. Chemical information is retrieved from -#' the internet. Additionally, it can be generated using RDKit if RDKit and its -#' python bindings are installed and configured for use with PythonInR. +#' @description The class is initialised with an identifier. Chemical +#' information is retrieved from the internet. Additionally, it can be +#' generated using RDKit if RDKit and its python bindings are installed. #' #' @export #' @format An \code{\link{R6Class}} generator object #' @importFrom R6 R6Class +#' @importFrom utils URLencode #' @importFrom webchem get_cid cid_compinfo #' @importFrom grImport PostScriptTrace readPicture #' @importFrom yaml yaml.load_file #' @importFrom rsvg rsvg_ps -#' @field identifier The identifier that was used to initiate the object, with attribute 'source' -#' @field inchikey InChI Key, with attribute 'source' -#' @field smiles SMILES code, with attribute 'source' -#' @field mw Molecular weight, with attribute 'source' -#' @field pubchem List of information retreived from PubChem -#' @field rdkit List of information obtained with RDKit, if installed and -#' configured for use with PythonInR -#' @field svg SVG code -#' @field Picture Graph as a \code{\link{picture}} object obtained using grImport -#' @field Pict_font_size Font size as extracted from the intermediate PostScript file -#' @field pdf_height Height of the MediaBox in the pdf after cropping -#' @field p0 Vapour pressure in Pa -#' @field cwsat Water solubility in mg/L -#' @field chyaml List of information obtained from a YAML file -#' @field soil_degradation Dataframe of modelling DT50 values -#' @field soil_ff Dataframe of formation fractions -#' @field soil_sorption Dataframe of soil sorption data -#' @field PUF Plant uptake factor -#' @keywords data - +#' @examples +#' oct <- chent$new("1-octanol", smiles = "CCCCCCCCO", pubchem = FALSE) +#' print(oct) +#' if (!is.null(oct$Picture)) { +#' plot(oct) +#' } +#' +#' caffeine <- chent$new("caffeine") +#' print(caffeine) +#' if (!is.null(caffeine$Picture)) { +#' plot(caffeine) +#' } chent <- R6Class("chent", - public <- list( + public = list( + #' @field identifier (`character(1)`)\cr + #' The identifier that was used to initiate the object, with attribute 'source' identifier = NULL, + + #' @field inchikey (`character(1)`)\cr + #' InChI Key, with attribute 'source' inchikey = NULL, + + #' @field smiles (`character()`)\cr + #' SMILES code(s), with attribute 'source' smiles = NULL, + + #' @field mw (`numeric(1)`)\cr + #' Molecular weight, with attribute 'source' mw = NULL, + + #' @field pubchem (`list()`)\cr + #' List of information retrieved from PubChem pubchem = NULL, + + #' @field rdkit + #' List of information obtained with RDKit rdkit = NULL, + + #' @field mol <rdkit.Chem.rdchem.Mol> object + mol = NULL, + + #' @field svg SVG code svg = NULL, + + #' @field Picture Graph as a \code{\link{picture}} object obtained using grImport Picture = NULL, + + #' @field Pict_font_size Font size as extracted from the intermediate PostScript file Pict_font_size = NULL, + + #' @field pdf_height Height of the MediaBox in the pdf after cropping pdf_height = NULL, + + #' @field p0 Vapour pressure in Pa p0 = NULL, + + #' @field cwsat Water solubility in mg/L cwsat = NULL, + + #' @field PUF Plant uptake factor PUF = NULL, + + #' @field chyaml List of information obtained from a YAML file chyaml = NULL, - initialize = function(identifier, smiles = NULL, smiles_source = 'user', - inchikey = NULL, inchikey_source = 'user', - pubchem = TRUE, pubchem_from = c('name', 'smiles', 'inchikey'), - rdkit = TRUE, template = NULL, - chyaml = TRUE) { + + #' @description + #' Creates a new instance of this [R6][R6::R6Class] class. + #' + #' @param identifier Identifier to be stored in the object + #' @param smiles Optional user provided SMILES code + #' @param inchikey Optional user provided InChI Key + #' @param pubchem Should an attempt be made to retrieve chemical + #' information from PubChem via the webchem package? + #' @param pubchem_from Possibility to select the argument + #' that is used to query pubchem + #' @param rdkit Should an attempt be made to retrieve chemical + #' information from a local rdkit installation via python + #' and the reticulate package? + #' @param template An optional SMILES code to be used as template for RDKit + #' @param chyaml Should we look for a identifier.yaml file in the working + #' directory? + initialize = function(identifier, smiles = NULL, inchikey = NULL, + pubchem = TRUE, pubchem_from = c('name', 'smiles', 'inchikey'), + rdkit = TRUE, template = NULL, + chyaml = TRUE) { self$identifier <- identifier names(self$identifier) <- make.names(identifier) @@ -86,42 +114,65 @@ chent <- R6Class("chent", } if (rdkit) { - if(rdkit_available()) { + if(rdkit_available) { if (is.null(self$smiles)) { message("RDKit would need a SMILES code") } else { + available_smiles <- names(self$smiles) + smiles_preference <- c("user", "PubChem_Isomeric", "PubChem_Canonical") + smiles_preferred_i <- min(match(available_smiles, smiles_preference)) + smiles_preferred <- smiles_preference[smiles_preferred_i] + message("Trying to get chemical information from RDKit using ", - names(self$smiles)[1], " SMILES\n", - self$smiles[1]) + smiles_preferred, " SMILES\n", + self$smiles[smiles_preferred]) self$get_rdkit(template = template) self$mw <- self$rdkit$mw attr(self$mw, "source") <- "rdkit" } } else { - message("RDKit is not available via PythonInR") + message("RDKit is not available") } } if (chyaml) { self$get_chyaml() } + + # Define main identifiers as NA if still not available + if (is.null(self$smiles)) { + self$smiles <- NA + attr(self$smiles, "source") <- "user" + } + if (is.null(self$inchikey)) { + self$inchikey<- NA + attr(self$inchikey, "source") <- "user" + } + if (is.null(self$mw)) { + self$mw<- NA + attr(self$mw, "source") <- "user" + } + invisible(self) }, + + #' Try to get chemical information from PubChem + #' @param query Query string to be passed to [get_cid][webchem::get_cid] + #' @param from Passed to [get_cid][webchem::get_cid] try_pubchem = function(query, from = 'name') { message("PubChem:") if (missing(query)) query <- self$identifier - pubchem_result = webchem::get_cid(query, from = from) + pubchem_result = webchem::get_cid(query, from = from, match = "first") - if (is.na(pubchem_result[[1]][1])) { + if (is.na(pubchem_result[[1, "cid"]])) { message("Query ", query, " did not give results at PubChem") } else { - n_results = length(pubchem_result[[1]]) - if (n_results > 1) { - warning("Found ", n_results, " entries in PubChem, using the first one.") - } self$get_pubchem(pubchem_result[[1, "cid"]]) } }, + + #' Get chemical information from PubChem for a known PubChem CID + #' @param pubchem_cid CID get_pubchem = function(pubchem_cid) { self$pubchem = as.list(webchem::pc_prop(pubchem_cid, from = "cid", properties = c("MolecularFormula", "MolecularWeight", @@ -144,31 +195,39 @@ chent <- R6Class("chent", self$inchikey <- self$pubchem$InChIKey attr(self$inchikey, "source") <- "pubchem" } else { - if (length(self$inchikey) > 1) { - message("InChIKey ", self$inchikey, " retreived from ", - attr(self$inchikey, "source"), - " has length > 1, using PubChem InChIKey") + if (is.na(self$inchikey)) { + warning("Overwriting uninitialized InChIKey") self$inchikey <- self$pubchem$InChIKey attr(self$inchikey, "source") <- "pubchem" } else { - if (self$pubchem$InChIKey != self$inchikey) { - message("InChiKey ", self$pubchem$InChIKey, " from PubChem record does not match\n", - "InChiKey ", self$inchikey, " retreived from ", - attr(self$inchikey, "source")) + if (length(self$inchikey) > 1) { + message("InChIKey ", self$inchikey, " retreived from ", + attr(self$inchikey, "source"), + " has length > 1, using PubChem InChIKey") + self$inchikey <- self$pubchem$InChIKey + attr(self$inchikey, "source") <- "pubchem" } else { - attr(self$inchikey, "source") <- c(attr(self$inchikey, "source"), "pubchem") + if (self$pubchem$InChIKey != self$inchikey) { + message("InChiKey ", self$pubchem$InChIKey, " from PubChem record does not match\n", + "InChiKey ", self$inchikey, " retreived from ", + attr(self$inchikey, "source")) + } else { + attr(self$inchikey, "source") <- c(attr(self$inchikey, "source"), "pubchem") + } } } } }, + + #' Get chemical information from RDKit if available + #' @param template Optional template specified as a SMILES code get_rdkit = function(template = NULL) { - if(!rdkit_available()) { - stop("RDKit is not available via PythonInR") + if (!rdkit_available) { + stop("RDKit is not available") } self$rdkit <- list() - PythonInR::pyImport("Descriptors", from = "rdkit.Chem") - PythonInR::pyExec(paste0("mol = Chem.MolFromSmiles('", self$smiles[1], "')")) - self$rdkit$mw <- PythonInR::pyExecg("mw = Descriptors.MolWt(mol)", "mw") + self$mol <- rdkit_module$Chem$MolFromSmiles(self$smiles[1]) + self$rdkit$mw <- rdkit_module$Chem$Descriptors$MolWt(self$mol) if (!is.null(self$mw)) { if (round(self$rdkit$mw, 1) != round(self$mw, 1)) { message("RDKit mw is ", self$rdkit$mw) @@ -177,20 +236,16 @@ chent <- R6Class("chent", } # Create an SVG representation - PythonInR::pyImport("Draw", from = "rdkit.Chem") - PythonInR::pyImport("rdMolDraw2D", from = "rdkit.Chem.Draw") - PythonInR::pyImport("rdDepictor", from = "rdkit.Chem") - PythonInR::pyExec("rdDepictor.Compute2DCoords(mol)") + rdkit_module$Chem$rdDepictor$Compute2DCoords(self$mol) if (!is.null(template)) { - PythonInR::pyImport("AllChem", from = "rdkit.Chem") - PythonInR::pyExec(paste0("template = Chem.MolFromSmiles('", template, "')")) - PythonInR::pyExec("AllChem.Compute2DCoords(template)") - PythonInR::pyExec("AllChem.GenerateDepictionMatching2DStructure(mol, template)") + rdkit_template <- rdkit_module$Chem$MolFromSmiles(template) + rdkit_module$Chem$rdDepictor$Compute2DCoords(template) + rdkit$Chem$AllChem$GenerateDepictionMatching2DStructure(self$mol, template) } - PythonInR::pyExec("d2d = rdMolDraw2D.MolDraw2DSVG(400,500)") - PythonInR::pyExec("d2d.DrawMolecule(mol)") - PythonInR::pyExec("d2d.FinishDrawing()") - self$svg <- PythonInR::pyGet("d2d.GetDrawingText()") + d2d <- rdkit_module$Chem$Draw$rdMolDraw2D$MolDraw2DSVG(400L, 400L) + d2d$DrawMolecule(self$mol) + d2d$FinishDrawing() + self$svg <- d2d$GetDrawingText() svgfile <- tempfile(fileext = ".svg") psfile <- tempfile(fileext = ".ps") writeLines(self$svg, svgfile) @@ -208,11 +263,19 @@ chent <- R6Class("chent", self$Picture <- readPicture(xmlfile) unlink(c(xmlfile, psfile, svgfile)) }, + + #' Obtain information from a YAML file + #' @param repo Should the file be looked for in the current working + #' directory, a local git repository under `~/git/chyaml`, or from + #' the web (not implemented). + #' @param chyaml The filename to be looked for get_chyaml = function(repo = c("wd", "local", "web"), - chyaml = paste0(URLencode(self$identifier), ".yaml")) { + chyaml = paste0(URLencode(self$identifier), ".yaml")) + { repo = match.arg(repo) - paths = c(wd = ".", - local = file.path("~", "git/chyaml")) + paths = c( + wd = ".", + local = file.path("~", "git/chyaml")) chyaml_handlers = list( expr = function(x) NULL, # To avoid security risks from reading chyaml files @@ -236,6 +299,13 @@ chent <- R6Class("chent", message("web repositories not implemented") } }, + + #' Add a vapour pressure + #' @param p0 The vapour pressure in Pa + #' @param T Temperature + #' @param source An acronym specifying the source of the information + #' @param page The page from which the information was taken + #' @param remark A remark add_p0 = function(p0, T = NA, source = NA, page = NA, remark = "") { self$p0 <- p0 attr(self$p0, "T") <- T @@ -243,7 +313,17 @@ chent <- R6Class("chent", attr(self$p0, "page") <- page attr(self$p0, "remark") <- remark }, - add_cwsat = function(cwsat, T = NA, pH = NA, source = NA, page = NA, remark = "") { + + #' Add a water solubility + #' @param cwsat The water solubility in mg/L + #' @param T Temperature + #' @param pH The pH value + #' @param source An acronym specifying the source of the information + #' @param page The page from which the information was taken + #' @param remark A remark + add_cwsat = function(cwsat, T = NA, pH = NA, + source = NA, page = NA, remark = "") + { self$cwsat <- cwsat attr(self$cwsat, "T") <- T attr(self$cwsat, "pH") <- pH @@ -251,13 +331,29 @@ chent <- R6Class("chent", attr(self$cwsat, "page") <- page attr(self$cwsat, "remark") <- remark }, - add_PUF = function(PUF = 0, source = "focus_generic_gw_2014", page = 41, remark = "Conservative default value") { + + #' Add a plant uptake factor + #' @param PUF The plant uptake factor, a number between 0 and 1 + #' @param source An acronym specifying the source of the information + #' @param page The page from which the information was taken + #' @param remark A remark + add_PUF = function(PUF = 0, + source = "focus_generic_gw_2014", page = 41, + remark = "Conservative default value") + { self$PUF <- PUF attr(self$PUF, "source") <- source attr(self$PUF, "page") <- page attr(self$PUF, "remark") <- remark }, + + #' @field TPs List of transformation products as chent objects TPs = list(), + + #' Add a transformation product to the internal list + #' @param x A [chent] object, or an identifier to generate a [chent] object + #' @param smiles A SMILES code for defining a [chent] object + #' @param pubchem Should chemical information be obtained from PubChem? add_TP = function(x, smiles = NULL, pubchem = FALSE) { if (inherits(x, "chent")) { id <- names(x$identifier) @@ -268,14 +364,28 @@ chent <- R6Class("chent", } self$TPs[[id]] <- chent }, + + #' @field transformations Data frame of observed transformations transformations = data.frame(study_type = character(0), - TP_identifier = character(0), - max_occurrence = numeric(0), - source = character(0), - pages = character(0), - stringsAsFactors = FALSE), + TP_identifier = character(0), + max_occurrence = numeric(0), + source = character(0), + page = character(0), + stringsAsFactors = FALSE), + + #' Add a line in the internal dataframe holding observed transformations + #' @param study_type A characterisation of the study type + #' @param TP_identifier An identifier of one of the transformation products + #' in `self$TPs` + #' @param max_occurrence The maximum observed occurrence of the + #' transformation product, expressed as a fraction of the amount that would + #' result from stochiometric transformation + #' @param source An acronym specifying the source of the information + #' @param pages The page from which the information was taken + #' @param remark A remark add_transformation = function(study_type, TP_identifier, max_occurrence, - remark = "", source = NA, pages = NA) { + remark = "", source = NA, pages = NA) + { TP_name = make.names(TP_identifier) if (!inherits(self$TPs[[TP_name]], "chent")) { stop(paste("Please add the TP", TP_identifier, "first using chent$add_TP()")) @@ -284,23 +394,49 @@ chent <- R6Class("chent", if (is.numeric(pages)) pages <- paste(pages, collapse = ", ") cn <- colnames(self$transformations) self$transformations <- rbind(self$transformations, - data.frame(study_type = study_type, - TP_identifier = TP_identifier, - max_occurrence = max_occurrence, - remark = remark, - source = source, - pages = pages, - stringsAsFactors = FALSE)) + data.frame(study_type = study_type, + TP_identifier = TP_identifier, + max_occurrence = max_occurrence, + remark = remark, + source = source, + page = page, + stringsAsFactors = FALSE)) }, + + #' @field soil_degradation Dataframe of modelling DT50 values soil_degradation = NULL, + + #' Add a line in the internal dataframe holding modelling DT50 values + #' @param soils Names of the soils + #' @param DT50_mod The modelling DT50 in the sense of regulatory pesticide + #' fate modelling + #' @param DT50_mod_ref The normalised modelling DT50 in the sense of + #' regulatory pesticide fate modelling + #' @param type The soil type + #' @param country The country (mainly for field studies) + #' @param pH_orig The pH stated in the study + #' @param pH_medium The medium in which this pH was measured + #' @param pH_H2O The pH extrapolated to pure water + #' @param perc_OC The percentage of organic carbon in the soil + #' @param temperature The temperature during the study in degrees Celsius + #' @param moisture The moisture during the study + #' @param category Is it a laboratory ('lab') or field study ('field') + #' @param formulation Name of the formulation applied, if it was not + #' the technical active ingredient + #' @param model The degradation model used for deriving `DT50_mod` + #' @param chi2 The relative error as defined in FOCUS kinetics + #' @param source An acronym specifying the source of the information + #' @param page The page from which the information was taken + #' @param remark A remark add_soil_degradation = function(soils, DT50_mod, DT50_mod_ref, - type = NA, country = NA, - pH_orig = NA, pH_medium = NA, pH_H2O = NA, - perc_OC = NA, - temperature = NA, moisture = NA, - category = "lab", formulation = NA, - model = NA, chi2 = NA, - remark = "", source, page = NA) { + type = NA, country = NA, + pH_orig = NA, pH_medium = NA, pH_H2O = NA, + perc_OC = NA, + temperature = NA, moisture = NA, + category = "lab", formulation = NA, + model = NA, chi2 = NA, + remark = "", source, page = NA) + { new_soil_degradation = data.frame( soil = soils, DT50_mod = DT50_mod, @@ -327,10 +463,20 @@ chent <- R6Class("chent", self$soil_degradation <- rbind(self$soil_degradation, new_soil_degradation) } }, + + #' @field soil_ff Dataframe of formation fractions soil_ff = NULL, - add_soil_ff = function(target, soils, ff = 1, remark = "", source, page = NA) { + + # Add one or more formation fractions for degradation in soil + #' @param target The identifier(s) of the transformation product + #' @param soils The soil name(s) in which the transformation was observed + #' @param ff The formation fraction(s) + add_soil_ff = function(target, soils, ff = 1, + remark = "", source, page = NA) + { new_soil_ff = data.frame( target = target, + target = target, soil = soils, ff = ff, remark = remark, @@ -343,13 +489,23 @@ chent <- R6Class("chent", self$soil_ff <- rbind(self$soil_ff, new_soil_ff) } }, + + #' @field soil_sorption Dataframe of soil sorption data soil_sorption = NULL, + + #' Add soil sorption data + #' @param Kf The sorption constant in L/kg, either linear (then `N` is 1) + #' or according to Freundlich + #' @param Kfoc The constant from above, normalised to soil organic carbon + #' @param N The Freundlich exponent + #' @param perc_clay The percentage of clay in the soil + #' @param CEC The cation exchange capacity add_soil_sorption = function(soils, Kf, Kfoc, N, - type = NA, - pH_orig = NA, pH_medium = NA, - pH_H2O = NA, - perc_OC = NA, perc_clay = NA, CEC = NA, - remark = "", source, page = NA) { + type = NA, pH_orig = NA, pH_medium = NA, + pH_H2O = NA, + perc_OC = NA, perc_clay = NA, CEC = NA, + remark = "", source, page = NA) + { new_soil_sorption = data.frame( soils = soils, Kf = Kf, Kfoc = Kfoc, N = N, @@ -368,8 +524,13 @@ chent <- R6Class("chent", self$soil_sorption <- rbind(self$soil_sorption, new_soil_sorption) } }, - pdf = function(file = paste0(self$identifier, ".pdf"), dir = "structures/pdf", - template = NULL) { + + #' Write a PDF image of the structure + #' @param file The file to write to + #' @param dir The directory to write the file to + #' @param template A template expressed as SMILES to use in RDKit + pdf = function(file = paste0(self$identifier, ".pdf"), + dir = "structures/pdf", template = NULL) { if (!dir.exists(dir)) { message("Directory '", dir, "' does not exist") message("Trying to create directory '", dir, "'") @@ -389,8 +550,12 @@ chent <- R6Class("chent", m_line <- suppressWarnings(grep("MediaBox", head, value = TRUE)) self$pdf_height <- as.numeric(gsub("/MediaBox \\[.* (.*)\\]", "\\1", m_line)) }, - png = function(file = paste0(self$identifier, ".png"), dir = "structures/png", - antialias = 'gray') { + + #' Write a PNG image of the structure + #' @param antialias Passed to [png][grDevices::png] + png = function(file = paste0(self$identifier, ".png"), + dir = "structures/png", antialias = 'gray') + { if (!dir.exists(dir)) { message("Directory '", dir, "' does not exist") message("Trying to create directory '", dir, "'") @@ -402,7 +567,12 @@ chent <- R6Class("chent", plot(self) dev.off() }, - emf = function(file = paste0(self$identifier, ".emf"), dir = "structures/emf") { + + #' Write an EMF image of the structure using [emf][devEMF::emf] + #' @param file The file to write to + emf = function(file = paste0(self$identifier, ".emf"), + dir = "structures/emf") + { if (!requireNamespace("devEMF")) { stop("You need to have the devEMF package installed for this function") } @@ -448,21 +618,16 @@ print.chent = function(x, ...) { #' @param subdir The path to which the file should be written #' @export draw_svg.chent = function(x, width = 300, height = 150, - filename = paste0(names(x$identifier), ".svg"), - subdir = "svg") { - if (!PythonInR::pyIsConnected()) { - PythonInR::pyConnect() - } - try_rdkit <- try(PythonInR::pyImport("Chem", from = "rdkit")) - if (inherits(try_rdkit, "try-error")) { - message("Could not import RDKit in Python session") + filename = paste0(names(x$identifier), ".svg"), + subdir = "svg") { + if (!rdkit_available) { + stop("RDkit is not available via reticulate") } else { if (!dir.exists(subdir)) dir.create(subdir) - PythonInR::pyExec(paste0("mol = Chem.MolFromSmiles('", x$smiles, "')")) - PythonInR::pyImport("Draw", from = "rdkit.Chem") - cmd <- paste0("Draw.MolToFile(mol, '", file.path(subdir, filename), - "', size = (", width, ", ", height, "))") - PythonInR::pyExec(cmd) + mol <- rdkit_module$Chem$MolFromSmiles(x$smiles) + + rdkit_module$Chem$Draw$MolToFile(mol, file.path(subdir, filename), + size = c(as.integer(width), as.integer(height))) } } @@ -472,36 +637,69 @@ draw_svg.chent = function(x, width = 300, height = 150, #' @param x The chent object to be plotted #' @param ... Further arguments passed to \code{\link{grid.picture}} #' @export +#' @examples +#' caffeine <- chent$new("caffeine") +#' print(caffeine) +#' if (!is.null(caffeine$Picture)) { +#' plot(caffeine) +#' } plot.chent = function(x, ...) { if (is.null(x$Picture)) stop("No Picture object in chent, was RDKit available during creation?") grid.picture(x$Picture) } -#' An R6 class for pesticidal active ingredients and associated data +#' @title An R6 class for pesticidal active ingredients and associated data #' -#' The class is initialised with an identifier which is generally an ISO common name. -#' Additional chemical information is retrieved from the internet if available. +#' @description The class is initialised with an identifier which is generally +#' an ISO common name. Additional chemical information is retrieved from the +#' internet if available. #' #' @docType class #' @importFrom R6 R6Class #' @export #' @format An \code{\link{R6Class}} generator object -#' @field iso ISO common name according to ISO 1750 as retreived from www.alanwood.net/pesticides -#' @field alanwood List of information retreived from www.alanwood.net/pesticides -#' @keywords data +#' @examples +#' # On Travis, we get a certificate validation error, +#' # likely because the system (xenial) is so old, +#' # therefore don't run this example on Travis +#' if (Sys.getenv("TRAVIS") == "") { +#' +#' atr <- pai$new("atrazine") +#' print(atr) +#' if (!is.null(atr$Picture)) { +#' plot(atr) +#' } +#' +#' } pai <- R6Class("pai", inherit = chent, - public <- list( + public = list( + + #' @field iso ISO common name of the active ingredient according to ISO 1750 iso = NULL, - alanwood = NULL, + + #' @field bcpc Information retrieved from the BCPC compendium available online + #' at <pesticidecompendium.bcpc.org> + bcpc = NULL, + + #' Creates a new instance of this [R6][R6::R6Class] class. + #' + #' @description This class is derived from [chent]. It makes it easy + #' to create a [chent] from the ISO common name of a pesticide active + #' ingredient, and additionally stores the ISO name as well as + #' the complete result of querying the BCPC compendium using + #' [bcpc_query][webchem::bcpc_query]. + #' + #' @param iso The ISO common name to be used in the query of the + #' BCPC compendium + #' + #' @param identifier Alternative identifier used for querying pubchem initialize = function(iso, identifier = iso, - smiles = NULL, smiles_source = 'user', - inchikey = NULL, inchikey_source = 'user', - alanwood = TRUE, - pubchem = TRUE, pubchem_from = 'auto', - rdkit = TRUE, template = NULL, - chyaml = TRUE) + smiles = NULL, inchikey = NULL, bcpc = TRUE, + pubchem = TRUE, pubchem_from = 'auto', + rdkit = TRUE, template = NULL, + chyaml = TRUE) { if (!is.null(inchikey)) { @@ -509,28 +707,28 @@ pai <- R6Class("pai", attr(self$inchikey, "source") <- "user" } - if (!missing(iso) & alanwood) { - message("alanwood.net:") - aw_result = webchem::aw_query(identifier, type = "commonname") + if (!missing(iso) & bcpc) { + message("BCPC:") + bcpc_result = webchem::bcpc_query(identifier, from = "name") # Use first element of list, as we passed a query of length one - if (is.na(aw_result[[1]][1])) { - message("Common name ", identifier, " is not known at www.alanwood.net, trying PubChem") + if (is.na(bcpc_result[[1]][1])) { + message("Common name ", identifier, " is not known at the BCPC compendium, trying PubChem") } else { - self$alanwood = aw_result[[1]] - self$iso = self$alanwood$cname - attr(self$iso, "source") <- "alanwood" - attr(self$iso, "status") <- self$alanwood$status - aw_ik = self$alanwood$inchikey - if (length(aw_ik) == 1 && nchar(aw_ik) == 27 && !is.na(aw_ik)) { + self$bcpc = bcpc_result[[1]] + self$iso = self$bcpc$cname + attr(self$iso, "source") <- "bcpc" + attr(self$iso, "status") <- self$bcpc$status + bcpc_ik = self$bcpc$inchikey + if (length(bcpc_ik) == 1 && !is.na(bcpc_ik)) { if (is.null(self$inchikey)) { - self$inchikey = self$alanwood$inchikey - attr(self$inchikey, "source") <- "alanwood" + self$inchikey = substr(self$bcpc$inchikey, 1, 27) + attr(self$inchikey, "source") <- "bcpc" } else { - if (aw_ik == self$inchikey) { - attr(self$inchikey, "source") = c(attr(self$inchikey, "source"), "alanwood") + if (bcpc_ik == self$inchikey) { + attr(self$inchikey, "source") = c(attr(self$inchikey, "source"), "bcpc") } else { - warning("InChIKey ", self$inchikey, " differs from ", aw_ik, " obtained from alanwood.net") + warning("InChIKey ", self$inchikey, " differs from ", bcpc_ik, " obtained from bcpc.org") } } } @@ -546,10 +744,9 @@ pai <- R6Class("pai", } super$initialize(identifier = identifier, - smiles = smiles, smiles_source = smiles_source, - inchikey = self$inchikey, - pubchem = pubchem, pubchem_from = pubchem_from, - rdkit = rdkit, template = template, chyaml = chyaml) + smiles = smiles, inchikey = self$inchikey, + pubchem = pubchem, pubchem_from = pubchem_from, + rdkit = rdkit, template = template, chyaml = chyaml) invisible(self) } @@ -574,30 +771,47 @@ print.pai = function(x, ...) { } } -#' R6 class for holding a product with at least one active ingredient +#' @title R6 class for a plant protection product with at least one active ingredient #' -#' An R6 class for holding information about a product with at least one active ingredient +#' @description Contains basic information about the active ingredients in the +#' product #' #' @docType class #' @importFrom R6 R6Class #' @export #' @format An \code{\link{R6Class}} generator object. -#' @field name The name of the product -#' @field ais A list of active ingredients -#' @field concentrations The concentration of the ais -#' @field concentration_units Defaults to g/L -#' @keywords data - -pp <- R6Class("pp", - public <- list( + +ppp <- R6Class("ppp", + public = list( + + #' @field name The name of the product name = NULL, + + #' @field ais A list of active ingredients ais = list(), + + #' @field concentrations The concentration of the ais concentrations = NULL, + + #' @field concentration_units Defaults to g/L concentration_units = NULL, + + #' @field density The density of the product density = NULL, + + #' @field density_units Defaults to g/L density_units = "g/L", + + #' Creates a new instance of this [R6][R6::R6Class] class. + #' + #' @field ... Identifiers of the active ingredients + #' @field concentrations Concentrations of the active ingredients + #' @field concentration_units Defaults to g/L + #' @field density The density + #' @field density_units Defaults to g/L initialize = function(name, ..., concentrations, concentration_units = "g/L", - density = 1000, density_units = "g/L") { + density = 1000, density_units = "g/L") + { self$name <- name self$ais <- list(...) self$concentrations <- concentrations @@ -606,29 +820,12 @@ pp <- R6Class("pp", names(self$concentrations) <- names(self$ais) self$concentration_units <- concentration_units }, + + #' Printing method print = function() { cat("<pp> named", self$name, "\n") } ) ) -rdkit_available <- function() -{ - if(requireNamespace("PythonInR", quietly = TRUE)) { - if (!PythonInR::pyIsConnected()) { - PythonInR::pyConnect() - } - sink(tempfile()) - try_rdkit <- try(PythonInR::pyImport("Chem", from = "rdkit"), - silent = TRUE) - sink() - if (inherits(try_rdkit, "try-error")) { - return(FALSE) - } else { - return(TRUE) - } - } else { - return(FALSE) - } -} # vim: set ts=2 sw=2 expandtab: @@ -0,0 +1,9 @@ +.onLoad = function(libname, pkgname) { + conf <- reticulate::py_discover_config("rdkit") + rdkit_available <- reticulate::py_module_available("rdkit") + rdkit_module <- try( + reticulate::import("rdkit"), + silent = TRUE) + assign('rdkit_available', rdkit_available, envir = topenv()) + assign('rdkit_module', rdkit_module, envir = topenv()) +} |