aboutsummaryrefslogtreecommitdiff
path: root/R/checksubstance.R
blob: 790182fbe56590bb36eb20d8a25a82b7663ffee1 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
checksubstance <- function(substance, db = "cytotox", 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")

    if (!(db %in% rownames(databases))) stop("Database is not supported")

    if (require("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.")
    }

    responsename = as.character(databases[db,1])
    testtype = as.character(databases[db,2])
    exptype = as.character(databases[db,3])

    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 = "")

    if (db == "ecotox") {
        query <- paste(query, " AND type LIKE '", 
                endpoint, "'", sep = "")
    }

    data <- RODBC::sqlQuery(channel,query)
    RODBC::odbcClose(channel)

    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)

    if (length(experiments)>6) {
        palette(rainbow(length(experiments)))      
    }
 
    plot(log10(data$conc),data[[responsename]],
        xlim=c(-2.5, 4.5),                                                                  
        ylim= c(-0.1, 2),                                                                 
        xlab=paste("decadic logarithm of the concentration in ",levels(data$unit)),    
        ylab=responsename)  
        
    explist <- split(data,data[[exptype]])
   
    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)))

    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