R/gtoxLoadData.R
In philipmorrisintl/GladiaTOX: R Package for Processing High Content Screening data
Defines functions
gtoxLoadData
Documented in
gtoxLoadData
#####################################################################
## 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. ##
#####################################################################
#-------------------------------------------------------------------------------
# gtoxLoadData: Load gtox data
#-------------------------------------------------------------------------------
#' @title Load gtox data
#'
#' @description
#' \code{gtoxLoadData} queries the gtox databases and returns a data.table with
#' data for the given level and data type.
#'
#' @param lvl Integer of length 1, the level of data to load
#' @param type Character of length 1, the data type, "sc" or "mc"
#' @param fld Character, the field(s) to query on
#' @param val List, vectors of values for each field to query on. Must be in
#' the same order as 'fld'.
#'
#' @details
#' The data type can be either 'mc' for mutliple concentration data, or 'sc'
#' for single concentration data. Multiple concentration data will be loaded
#' into the 'mc' tables, whereas the single concentration will be loaded into
#' the 'sc' tables.
#'
#' Setting 'lvl' to "agg" will return an aggregate table containing the m4id
#' with the concentration-response data and m3id to map back to well-level
#' information.
#'
#' Leaving \code{fld} NULL will return all data.
#'
#' Valid \code{fld} inputs are based on the data level and type:
#' \tabular{ccl}{
#' type \tab lvl \tab Queried tables \cr
#' sc \tab 0 \tab sc0 \cr
#' sc \tab 1 \tab sc0, sc1 \cr
#' sc \tab agg \tab sc1, sc2_agg \cr
#' sc \tab 2 \tab sc2 \cr
#' mc \tab 0 \tab mc0 \cr
#' mc \tab 1 \tab mc0, mc1 \cr
#' mc \tab 2 \tab mc0, mc1, mc2 \cr
#' mc \tab 3 \tab mc0, mc1, mc3 \cr
#' mc \tab agg \tab mc3, mc4_agg \cr
#' mc \tab 4 \tab mc4 \cr
#' mc \tab 5 \tab mc4, mc5 \cr
#' mc \tab 6 \tab mc4, mc6
#' }
#'
#' @examples
#' ## Store the current config settings, so they can be reloaded at the end
#' ## of the examples
#' conf_store <- gtoxConfList()
#' gtoxConfDefault()
#'
#' ## Load all of level 0 for multiple-concentration data, note 'mc' is the
#' ## default value for type
#' gtoxLoadData(lvl = 0)
#'
#' ## Load all of level 1 for single-concentration
#' gtoxLoadData(lvl = 1, type = "sc")
#'
#' ## List the fields available for level 1, coming from tables mc0 and mc1
#' gtoxListFlds(tbl = "mc0")
#' gtoxListFlds(tbl = "mc1")
#'
#' ## Load level 0 data where the well type is "t" and the concentration
#' ## index is 3 or 4
#' gtoxLoadData(lvl = 1, fld = c("wllt", "cndx"), val = list("t", c(3:4)))
#'
#' ## Reset configuration
#' options(conf_store)
#'
#' @return A data.table containing data for the given fields.
#'
#' @seealso \code{\link{gtoxQuery}}, \code{\link{data.table}}
#'
#' @import data.table
#' @export
gtoxLoadData <- function(lvl, fld=NULL, val=NULL, type="mc") {
if (length(lvl) > 1 | length(type) > 1) {
stop("'lvl' & 'type' must be of length 1.")
}
tbls <- NULL
if (lvl == 0L && type == "mc") {
tbls <- c("assay_plate_well", "mc0")
qformat <-
"
SELECT
m0id,
mc0.waid as waid,
spid,
acid,
apid,
rowi,
coli,
wllt,
vhid,
wllq,
conc,
rval
FROM
assay_plate_well,
mc0
WHERE
mc0.waid=assay_plate_well.waid
"
}
if (lvl == 0L && type == "sc") {
tbls <- c("sc0")
qformat <-
"
SELECT
s0id,
spid,
acid,
apid,
rowi,
coli,
wllt,
vhid,
wllq,
conc,
rval
FROM
assay_plate_well,
sc0
WHERE
sc0.waid=assay_plate_well.waid
"
}
if (lvl == 1L && type == "mc") {
tbls <- c("assay_plate_well", "mc0", "mc1")
qformat <-
"
SELECT
mc1.m0id,
m1id,
spid,
mc1.acid,
apid,
rowi,
coli,
wllt,
vhid,
wllq,
conc,
rval,
cndx,
repi
FROM
assay_plate_well,
mc0,
mc1
WHERE
mc0.waid=assay_plate_well.waid
AND
mc0.m0id=mc1.m0id
"
}
if (lvl == 1L && type == "sc") {
tbls <- c("assay_plate_well", "sc0", "sc1")
qformat <-
"
SELECT
sc1.s0id,
s1id,
spid,
sc1.acid,
aeid,
apid,
rowi,
coli,
wllt,
vhid,
logc,
resp
FROM
assay_plate_well,
sc0,
sc1
WHERE
sc0.waid=assay_plate_well.waid
AND
sc0.s0id=sc1.s0id
"
}
if (lvl == 2L && type == "mc") {
tbls <- c("assay_plate_well", "mc0", "mc1", "mc2")
qformat <-
"
SELECT
mc2.m0id,
mc2.m1id,
m2id,
spid,
mc2.acid,
apid,
rowi,
coli,
wllt,
vhid,
conc,
cval,
cndx,
repi
FROM
assay_plate_well,
mc0,
mc1,
mc2
WHERE
mc0.waid=assay_plate_well.waid
AND
mc0.m0id=mc1.m0id
AND
mc1.m0id=mc2.m0id
"
}
if (lvl == 2L && type == "sc") {
tbls <- c("assay_plate_well", "sc2")
qformat <-
"
SELECT
s2id,
spid,
aeid,
bmad,
max_med,
hitc,
coff
FROM
sc2
"
}
if (lvl == "agg" && type == "sc") {
tbls <- c("assay_plate_well", "sc1", "sc2_agg")
qformat <-
"
SELECT
sc2_agg.aeid,
sc2_agg.s2id,
sc2_agg.s1id,
sc2_agg.s0id,
logc,
resp
FROM
sc1,
sc2_agg
WHERE
sc1.s1id=sc2_agg.s1id
"
}
if (lvl == 3L && type == "mc") {
tbls <- c("assay_plate_well", "mc0", "mc1", "mc3")
qformat <-
"
SELECT
mc3.m0id,
mc3.m1id,
mc3.m2id,
m3id,
spid,
aeid,
logc,
resp,
cndx,
wllt,
vhid,
apid,
rowi,
coli,
repi
FROM
assay_plate_well,
mc0,
mc1,
mc3
WHERE
mc0.waid=assay_plate_well.waid
AND
mc0.m0id=mc1.m0id
AND
mc1.m0id=mc3.m0id
"
}
if (lvl == "agg" && type == "mc") {
tbls <- c("mc3", "mc4_agg")
qformat <-
"
SELECT
mc4_agg.aeid,
mc4_agg.m4id,
mc4_agg.m3id,
mc4_agg.m2id,
mc4_agg.m1id,
mc4_agg.m0id,
logc,
resp
FROM
mc3,
mc4_agg
WHERE
mc3.m3id=mc4_agg.m3id
"
}
if (lvl == 4L && type == "mc") {
tbls <- c("mc4")
qformat <-
"
SELECT
m4id,
aeid,
spid,
bmad,
resp_max,
resp_min,
max_mean,
max_mean_conc,
max_med,
max_med_conc,
logc_max,
logc_min,
cnst,
hill,
hcov,
gnls,
gcov,
cnst_er,
cnst_aic,
cnst_rmse,
cnst_prob,
hill_tp,
hill_tp_sd,
hill_ga,
hill_ga_sd,
hill_gw,
hill_gw_sd,
hill_er,
hill_er_sd,
hill_aic,
hill_rmse,
hill_prob,
gnls_tp,
gnls_tp_sd,
gnls_ga,
gnls_ga_sd,
gnls_gw,
gnls_gw_sd,
gnls_la,
gnls_la_sd,
gnls_lw,
gnls_lw_sd,
gnls_er,
gnls_er_sd,
gnls_aic,
gnls_rmse,
gnls_prob,
nconc,
npts,
nrep,
nmed_gtbl
FROM
mc4
"
}
if (lvl == 5L && type == "mc") {
tbls <- c("mc4", "mc5")
qformat <-
"
SELECT
m5id,
mc5.m4id,
mc5.aeid,
spid,
bmad,
resp_max,
resp_min,
max_mean,
max_mean_conc,
max_med,
max_med_conc,
logc_max,
logc_min,
cnst,
hill,
hcov,
gnls,
gcov,
cnst_er,
cnst_aic,
cnst_rmse,
cnst_prob,
hill_tp,
hill_tp_sd,
hill_ga,
hill_ga_sd,
hill_gw,
hill_gw_sd,
hill_er,
hill_er_sd,
hill_aic,
hill_rmse,
hill_prob,
gnls_tp,
gnls_tp_sd,
gnls_ga,
gnls_ga_sd,
gnls_gw,
gnls_gw_sd,
gnls_la,
gnls_la_sd,
gnls_lw,
gnls_lw_sd,
gnls_er,
gnls_er_sd,
gnls_aic,
gnls_rmse,
gnls_prob,
nconc,
npts,
nrep,
nmed_gtbl,
hitc,
modl,
fitc,
coff,
actp,
modl_er,
modl_tp,
modl_ga,
modl_gw,
modl_la,
modl_lw,
modl_rmse,
modl_prob,
modl_acc,
modl_acb
FROM
mc4,
mc5
WHERE
mc4.m4id=mc5.m4id
"
}
if (lvl == 6L && type == "mc") {
tbls <- c("mc4", "mc6")
qformat <-
"
SELECT
mc6.aeid,
m6id,
mc6.m4id,
m5id,
spid,
mc6_mthd_id,
flag,
fval,
fval_unit
FROM
mc4,
mc6
WHERE
mc6.m4id=mc4.m4id
"
}
if (is.null(tbls)) stop("Invalid 'lvl' and 'type' combination.")
if (!is.null(fld)) {
fld <- .prepField(fld=fld, tbl=tbls, db=options()$TCPL_DB)
wtest <- lvl == 4 | (lvl == 2 & type == "sc")
qformat <- paste(qformat, if (wtest) "WHERE" else "AND")
qformat <- paste0(
qformat,
" ",
paste(fld, "IN (%s)", collapse=" AND ")
)
qformat <- paste0(qformat, ";")
if (!is.list(val)) val <- list(val)
val <- lapply(
val, function(x) paste0("\"", x, "\"", collapse=",")
)
qstring <- do.call(sprintf, args=c(qformat, val))
} else {
qstring <- qformat
}
dat <- suppressWarnings(gtoxQuery(query=qstring, db=options()$TCPL_DB))
dat[]
}
#-------------------------------------------------------------------------------
philipmorrisintl/GladiaTOX documentation built on Aug. 27, 2023, 9:07 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions gtoxLoadData
Documented in gtoxLoadData
#####################################################################
## 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. ##
#####################################################################
#-------------------------------------------------------------------------------
# gtoxLoadData: Load gtox data
#-------------------------------------------------------------------------------
#' @title Load gtox data
#'
#' @description
#' \code{gtoxLoadData} queries the gtox databases and returns a data.table with
#' data for the given level and data type.
#'
#' @param lvl Integer of length 1, the level of data to load
#' @param type Character of length 1, the data type, "sc" or "mc"
#' @param fld Character, the field(s) to query on
#' @param val List, vectors of values for each field to query on. Must be in
#' the same order as 'fld'.
#'
#' @details
#' The data type can be either 'mc' for mutliple concentration data, or 'sc'
#' for single concentration data. Multiple concentration data will be loaded
#' into the 'mc' tables, whereas the single concentration will be loaded into
#' the 'sc' tables.
#'
#' Setting 'lvl' to "agg" will return an aggregate table containing the m4id
#' with the concentration-response data and m3id to map back to well-level
#' information.
#'
#' Leaving \code{fld} NULL will return all data.
#'
#' Valid \code{fld} inputs are based on the data level and type:
#' \tabular{ccl}{
#' type \tab lvl \tab Queried tables \cr
#' sc \tab 0 \tab sc0 \cr
#' sc \tab 1 \tab sc0, sc1 \cr
#' sc \tab agg \tab sc1, sc2_agg \cr
#' sc \tab 2 \tab sc2 \cr
#' mc \tab 0 \tab mc0 \cr
#' mc \tab 1 \tab mc0, mc1 \cr
#' mc \tab 2 \tab mc0, mc1, mc2 \cr
#' mc \tab 3 \tab mc0, mc1, mc3 \cr
#' mc \tab agg \tab mc3, mc4_agg \cr
#' mc \tab 4 \tab mc4 \cr
#' mc \tab 5 \tab mc4, mc5 \cr
#' mc \tab 6 \tab mc4, mc6
#' }
#'
#' @examples
#' ## Store the current config settings, so they can be reloaded at the end
#' ## of the examples
#' conf_store <- gtoxConfList()
#' gtoxConfDefault()
#'
#' ## Load all of level 0 for multiple-concentration data, note 'mc' is the
#' ## default value for type
#' gtoxLoadData(lvl = 0)
#'
#' ## Load all of level 1 for single-concentration
#' gtoxLoadData(lvl = 1, type = "sc")
#'
#' ## List the fields available for level 1, coming from tables mc0 and mc1
#' gtoxListFlds(tbl = "mc0")
#' gtoxListFlds(tbl = "mc1")
#'
#' ## Load level 0 data where the well type is "t" and the concentration
#' ## index is 3 or 4
#' gtoxLoadData(lvl = 1, fld = c("wllt", "cndx"), val = list("t", c(3:4)))
#'
#' ## Reset configuration
#' options(conf_store)
#'
#' @return A data.table containing data for the given fields.
#'
#' @seealso \code{\link{gtoxQuery}}, \code{\link{data.table}}
#'
#' @import data.table
#' @export
gtoxLoadData <- function(lvl, fld=NULL, val=NULL, type="mc") {
if (length(lvl) > 1 | length(type) > 1) {
stop("'lvl' & 'type' must be of length 1.")
}
tbls <- NULL
if (lvl == 0L && type == "mc") {
tbls <- c("assay_plate_well", "mc0")
qformat <-
"
SELECT
m0id,
mc0.waid as waid,
spid,
acid,
apid,
rowi,
coli,
wllt,
vhid,
wllq,
conc,
rval
FROM
assay_plate_well,
mc0
WHERE
mc0.waid=assay_plate_well.waid
"
}
if (lvl == 0L && type == "sc") {
tbls <- c("sc0")
qformat <-
"
SELECT
s0id,
spid,
acid,
apid,
rowi,
coli,
wllt,
vhid,
wllq,
conc,
rval
FROM
assay_plate_well,
sc0
WHERE
sc0.waid=assay_plate_well.waid
"
}
if (lvl == 1L && type == "mc") {
tbls <- c("assay_plate_well", "mc0", "mc1")
qformat <-
"
SELECT
mc1.m0id,
m1id,
spid,
mc1.acid,
apid,
rowi,
coli,
wllt,
vhid,
wllq,
conc,
rval,
cndx,
repi
FROM
assay_plate_well,
mc0,
mc1
WHERE
mc0.waid=assay_plate_well.waid
AND
mc0.m0id=mc1.m0id
"
}
if (lvl == 1L && type == "sc") {
tbls <- c("assay_plate_well", "sc0", "sc1")
qformat <-
"
SELECT
sc1.s0id,
s1id,
spid,
sc1.acid,
aeid,
apid,
rowi,
coli,
wllt,
vhid,
logc,
resp
FROM
assay_plate_well,
sc0,
sc1
WHERE
sc0.waid=assay_plate_well.waid
AND
sc0.s0id=sc1.s0id
"
}
if (lvl == 2L && type == "mc") {
tbls <- c("assay_plate_well", "mc0", "mc1", "mc2")
qformat <-
"
SELECT
mc2.m0id,
mc2.m1id,
m2id,
spid,
mc2.acid,
apid,
rowi,
coli,
wllt,
vhid,
conc,
cval,
cndx,
repi
FROM
assay_plate_well,
mc0,
mc1,
mc2
WHERE
mc0.waid=assay_plate_well.waid
AND
mc0.m0id=mc1.m0id
AND
mc1.m0id=mc2.m0id
"
}
if (lvl == 2L && type == "sc") {
tbls <- c("assay_plate_well", "sc2")
qformat <-
"
SELECT
s2id,
spid,
aeid,
bmad,
max_med,
hitc,
coff
FROM
sc2
"
}
if (lvl == "agg" && type == "sc") {
tbls <- c("assay_plate_well", "sc1", "sc2_agg")
qformat <-
"
SELECT
sc2_agg.aeid,
sc2_agg.s2id,
sc2_agg.s1id,
sc2_agg.s0id,
logc,
resp
FROM
sc1,
sc2_agg
WHERE
sc1.s1id=sc2_agg.s1id
"
}
if (lvl == 3L && type == "mc") {
tbls <- c("assay_plate_well", "mc0", "mc1", "mc3")
qformat <-
"
SELECT
mc3.m0id,
mc3.m1id,
mc3.m2id,
m3id,
spid,
aeid,
logc,
resp,
cndx,
wllt,
vhid,
apid,
rowi,
coli,
repi
FROM
assay_plate_well,
mc0,
mc1,
mc3
WHERE
mc0.waid=assay_plate_well.waid
AND
mc0.m0id=mc1.m0id
AND
mc1.m0id=mc3.m0id
"
}
if (lvl == "agg" && type == "mc") {
tbls <- c("mc3", "mc4_agg")
qformat <-
"
SELECT
mc4_agg.aeid,
mc4_agg.m4id,
mc4_agg.m3id,
mc4_agg.m2id,
mc4_agg.m1id,
mc4_agg.m0id,
logc,
resp
FROM
mc3,
mc4_agg
WHERE
mc3.m3id=mc4_agg.m3id
"
}
if (lvl == 4L && type == "mc") {
tbls <- c("mc4")
qformat <-
"
SELECT
m4id,
aeid,
spid,
bmad,
resp_max,
resp_min,
max_mean,
max_mean_conc,
max_med,
max_med_conc,
logc_max,
logc_min,
cnst,
hill,
hcov,
gnls,
gcov,
cnst_er,
cnst_aic,
cnst_rmse,
cnst_prob,
hill_tp,
hill_tp_sd,
hill_ga,
hill_ga_sd,
hill_gw,
hill_gw_sd,
hill_er,
hill_er_sd,
hill_aic,
hill_rmse,
hill_prob,
gnls_tp,
gnls_tp_sd,
gnls_ga,
gnls_ga_sd,
gnls_gw,
gnls_gw_sd,
gnls_la,
gnls_la_sd,
gnls_lw,
gnls_lw_sd,
gnls_er,
gnls_er_sd,
gnls_aic,
gnls_rmse,
gnls_prob,
nconc,
npts,
nrep,
nmed_gtbl
FROM
mc4
"
}
if (lvl == 5L && type == "mc") {
tbls <- c("mc4", "mc5")
qformat <-
"
SELECT
m5id,
mc5.m4id,
mc5.aeid,
spid,
bmad,
resp_max,
resp_min,
max_mean,
max_mean_conc,
max_med,
max_med_conc,
logc_max,
logc_min,
cnst,
hill,
hcov,
gnls,
gcov,
cnst_er,
cnst_aic,
cnst_rmse,
cnst_prob,
hill_tp,
hill_tp_sd,
hill_ga,
hill_ga_sd,
hill_gw,
hill_gw_sd,
hill_er,
hill_er_sd,
hill_aic,
hill_rmse,
hill_prob,
gnls_tp,
gnls_tp_sd,
gnls_ga,
gnls_ga_sd,
gnls_gw,
gnls_gw_sd,
gnls_la,
gnls_la_sd,
gnls_lw,
gnls_lw_sd,
gnls_er,
gnls_er_sd,
gnls_aic,
gnls_rmse,
gnls_prob,
nconc,
npts,
nrep,
nmed_gtbl,
hitc,
modl,
fitc,
coff,
actp,
modl_er,
modl_tp,
modl_ga,
modl_gw,
modl_la,
modl_lw,
modl_rmse,
modl_prob,
modl_acc,
modl_acb
FROM
mc4,
mc5
WHERE
mc4.m4id=mc5.m4id
"
}
if (lvl == 6L && type == "mc") {
tbls <- c("mc4", "mc6")
qformat <-
"
SELECT
mc6.aeid,
m6id,
mc6.m4id,
m5id,
spid,
mc6_mthd_id,
flag,
fval,
fval_unit
FROM
mc4,
mc6
WHERE
mc6.m4id=mc4.m4id
"
}
if (is.null(tbls)) stop("Invalid 'lvl' and 'type' combination.")
if (!is.null(fld)) {
fld <- .prepField(fld=fld, tbl=tbls, db=options()$TCPL_DB)
wtest <- lvl == 4 | (lvl == 2 & type == "sc")
qformat <- paste(qformat, if (wtest) "WHERE" else "AND")
qformat <- paste0(
qformat,
" ",
paste(fld, "IN (%s)", collapse=" AND ")
)
qformat <- paste0(qformat, ";")
if (!is.list(val)) val <- list(val)
val <- lapply(
val, function(x) paste0("\"", x, "\"", collapse=",")
)
qstring <- do.call(sprintf, args=c(qformat, val))
} else {
qstring <- qformat
}
dat <- suppressWarnings(gtoxQuery(query=qstring, db=options()$TCPL_DB))
dat[]
}
#-------------------------------------------------------------------------------
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.