aboutsummaryrefslogtreecommitdiff
path: root/R/checksubstance.R
diff options
context:
space:
mode:
authorJohannes Ranke <johannes.ranke@jrwb.de>2018-09-15 19:04:23 +0200
committerJohannes Ranke <johannes.ranke@jrwb.de>2018-09-15 19:04:23 +0200
commitc61698e427974faffd9b43755a51b6eb9122be90 (patch)
tree4c33adebdcf538143ae1f9fcd8785f03e6c47efb /R/checksubstance.R
parent23528ad9b4f07434b3249f1e48ade1e0d07528bf (diff)
Switch to odbc, reformattting of code
to make it more readable. Also remove outdated hyperlinks from the help files.
Diffstat (limited to 'R/checksubstance.R')
-rw-r--r--R/checksubstance.R158
1 files changed, 78 insertions, 80 deletions
diff --git a/R/checksubstance.R b/R/checksubstance.R
index f22d4e2..e74ad21 100644
--- a/R/checksubstance.R
+++ b/R/checksubstance.R
@@ -1,97 +1,95 @@
-checksubstance <- function(substance, db = "cytotox", experimentator = "%",
- celltype = "%", enzymetype = "%", organism = "%",
- endpoint = "%",
- whereClause = "1", ok= "%")
+checksubstance <- function(substance,
+ db = c("cytotox", "enzymes", "ecotox"),
+ experimentator = "%",
+ celltype = "%", enzymetype = "%", organism = "%",
+ endpoint = "%",
+ whereClause = "1", ok= "%")
{
- databases <- data.frame(
- responsename=c("viability","activity","response"),
- testtype=c("celltype","enzyme","organism"),
- exptype=c("plate","plate","experiment"))
- rownames(databases) <- c("cytotox","enzymes","ecotox")
+ db = match.arg(db)
- if (!(db %in% rownames(databases))) stop("Database is not supported")
+ databases <- data.frame(
+ responsename = c("viability", "activity", "raw_response"),
+ testtype = c("celltype", "enzyme", "organism"),
+ exptype = c("plate", "plate", "experiment"),
+ row.names = c("cytotox", "enzymes", "ecotox"),
+ stringsAsFactors = FALSE)
- if (requireNamespace("RODBC")) {
- channel <- RODBC::odbcConnect(db, uid="cytotox", pwd="cytotox", case="tolower")
- } else {
- stop("For this function, the RODBC package has to be installed and configured.")
- }
+ con <- dbConnect(odbc(), "cytotox", database = db)
- responsename = as.character(databases[db,1])
- testtype = as.character(databases[db,2])
- exptype = as.character(databases[db,3])
+ responsename <- databases[db, 1]
+ testtype <- databases[db, 2]
+ exptype <- databases[db, 3]
- if (db == "cytotox") {
- type <- celltype
- }
- if (db == "enzymes") {
- type <- enzymetype
- }
- if (db == "ecotox") {
- type <- organism
- }
+ if (db == "cytotox") {
+ type <- celltype
+ }
+ if (db == "enzymes") {
+ type <- enzymetype
+ }
+ if (db == "ecotox") {
+ type <- organism
+ }
- query <- paste("SELECT experimentator,substance,",
- testtype, ",", exptype, ",conc,unit,",responsename,",ok",
- " FROM ",db," WHERE substance LIKE '",
- substance,"' AND experimentator LIKE '",
- experimentator,"' AND ",testtype," LIKE '",
- type,"' AND ",
- whereClause," AND ok LIKE '",ok,"'",
- sep = "")
+ query <- paste("SELECT experimentator,substance,",
+ testtype, ",", exptype, ",conc,unit,",responsename,",ok",
+ " FROM ",db," WHERE substance LIKE '",
+ substance,"' AND experimentator LIKE '",
+ experimentator,"' AND ",testtype," LIKE '",
+ type,"' AND ",
+ whereClause," AND ok LIKE '",ok,"'",
+ sep = "")
- if (db == "ecotox") {
- query <- paste(query, " AND type LIKE '",
- endpoint, "'", sep = "")
- }
+ if (db == "ecotox") {
+ query <- paste(query, " AND type LIKE '",
+ endpoint, "'", sep = "")
+ }
- data <- RODBC::sqlQuery(channel,query)
- RODBC::odbcClose(channel)
+ data <- dbGetQuery(con, query)
- if (length(data$experimentator) < 1) {
- stop(paste("\nNo response data for",substance,"in database",
- db,"found with these parameters\n"))
- }
+ if (length(data$experimentator) < 1) {
+ stop(paste("\nNo response data for",substance,"in database",
+ db,"found with these parameters\n"))
+ }
- data$experimentator <- factor(data$experimentator)
- data$substance <- factor(data$substance)
- substances <- levels(data$substance)
- data$type <- factor(data[[testtype]])
- data[[exptype]] <- factor(data[[exptype]])
- experiments <- levels(data[[exptype]])
- concentrations <- split(data$conc,data$conc)
- concentrations <- as.numeric(names(concentrations))
- data$unit <- factor(data$unit)
- data$ok <- factor(data$ok)
+ data$experimentator <- factor(data$experimentator)
+ data$substance <- factor(data$substance)
+ substances <- levels(data$substance)
+ data$type <- factor(data[[testtype]])
+ data[[exptype]] <- factor(data[[exptype]])
+ experiments <- levels(data[[exptype]])
+ concentrations <- split(data$conc,data$conc)
+ concentrations <- as.numeric(names(concentrations))
+ data$unit <- factor(data$unit)
+ data$ok <- factor(data$ok)
- if (length(experiments)>6) {
- palette(rainbow(length(experiments)))
- }
+ if (length(experiments)>6) {
+ palette(rainbow(length(experiments)))
+ }
- plot(log10(data$conc),data[[responsename]],
- xlim=c(-2.5, 4.5),
- ylim= range(data[[responsename]], na.rm = TRUE),
- xlab=paste("decadic logarithm of the concentration in ",levels(data$unit)),
- ylab=responsename)
+ plot(log10(data$conc),data[[responsename]],
+ xlim=c(-2.5, 4.5),
+ ylim= range(data[[responsename]], na.rm = TRUE),
+ xlab=paste("decadic logarithm of the concentration in ",levels(data$unit)),
+ ylab=responsename)
- explist <- split(data,data[[exptype]])
+ explist <- split(data,data[[exptype]])
- for (i in 1:length(explist)) {
- points(log10(explist[[i]]$conc),explist[[i]][[responsename]],col=i);
- }
+ for (i in 1:length(explist)) {
+ points(log10(explist[[i]]$conc),explist[[i]][[responsename]],col=i);
+ }
- legend("topleft", experiments, pch=1, col=1:length(experiments), inset=0.05)
- title(main=paste(substance," - ",levels(data$experimentator)," - ",levels(data$type)))
+ legend("topleft", experiments, pch=1, col=1:length(experiments), inset=0.05)
+ title(main=paste(substance," - ",levels(data$experimentator)," - ",levels(data$type)))
- exptypename <- paste(toupper(substring(exptype,1,1)),
- substring(exptype,2), sep = "")
- experimentators <- paste(levels(data$experimentator), collapse = " ")
- types <- paste(levels(data$type), collapse = " ")
- experiments <- paste(levels(data[[exptype]]), collapse = " ")
- class(experiments)
- cat("\n\tSubstanz:\t\t",substance,"\n",
- "\tExperimentator(s):\t", experimentators,"\n",
- "\tType(s): \t\t",types,"\n",
- "\tEndpoint: \t\t",endpoint,"\n",
- "\t", exptypename, "(s):\t\t",experiments,"\n\n", sep = "")
+ exptypename <- paste(toupper(substring(exptype,1,1)),
+ substring(exptype,2), sep = "")
+ experimentators <- paste(levels(data$experimentator), collapse = " ")
+ types <- paste(levels(data$type), collapse = " ")
+ experiments <- paste(levels(data[[exptype]]), collapse = " ")
+ class(experiments)
+ cat("\n\tSubstanz:\t\t",substance,"\n",
+ "\tExperimentator(s):\t", experimentators,"\n",
+ "\tType(s): \t\t",types,"\n",
+ "\tEndpoint: \t\t",endpoint,"\n",
+ "\t", exptypename, "(s):\t\t",experiments,"\n\n", sep = "")
}

Contact - Imprint