Nothing
setClass("WMD",
slots = c(metadata = "list"),
contains = "VIRTUAL",
sealed = SEALED
)
setClass("WMDS",
slots = c(plates = "list"),
contains = "VIRTUAL",
sealed = SEALED
)
NULL
setClassUnion("WMDX", c("WMD", "WMDS"))
NULL
setClassUnion("FOE", c("formula", "expression"))
setClass("OPM",
slots = c(measurements = "matrix", csv_data = "character"),
contains = "WMD",
validity = function(object) {
errs <- c(opm_problems(object@measurements), opm_problems(object@csv_data))
if (length(errs))
errs
else
TRUE
},
sealed = SEALED
)
setClass("OPMA",
slots = c(aggregated = "matrix", aggr_settings = "list"),
contains = "OPM",
validity = function(object) {
settings <- object@aggr_settings
if (length(errs <- opma_problems(settings)))
settings <- NULL # => no settings-based checks of the matrix
errs <- c(errs, opma_problems(object@aggregated, object@measurements,
settings))
if (length(errs))
errs
else
TRUE
},
sealed = SEALED
)
setClass("OPMD",
slots = c(discretized = "logical", disc_settings = "list"),
contains = "OPMA",
validity = function(object) {
errs <- opmd_problems(object@disc_settings)
errs <- c(errs, opmd_problems(object@aggregated, object@discretized,
object@disc_settings[[c(OPTIONS, "parameter")]]))
if (length(errs))
errs
else
TRUE
},
sealed = SEALED
)
setClass("OPMS",
contains = "WMDS",
validity = function(object) {
if (length(errs <- opms_problems(object@plates)))
errs
else
TRUE
},
sealed = SEALED
)
setClass("MOPMX",
contains = "list",
slots = c(names = "character"),
prototype = prototype(names = character()),
validity = function(object) {
if (all(vapply(object@.Data, is, NA, "OPMX")))
TRUE
else
"not ell elements inherit from 'OPMX'"
}, sealed = SEALED
)
setClass("OPM_MCP_OUT",
contains = "data.frame",
validity = function(object) {
errs <- NULL
for (name in RESERVED_NAMES[c("well", "value")])
if (!name %in% colnames(object))
errs <- c(errs, sprintf("missing column named '%s'", name))
if (length(errs))
errs
else
TRUE
},
sealed = SEALED
)
NULL
setClassUnion("OPMX", c("OPM", "OPMS"))
NULL
setClassUnion("XOPMX", c("MOPMX", "OPMS", "OPM"))
NULL
setOldClass("print_easy")
setClassUnion("YAML_VIA_LIST", c("OPM", "OPMS", "print_easy"))
setClass("CMAT",
contains = "matrix",
validity = function(object) {
errs <- character()
if (is.null(rownames(object)) || anyNA(rownames(object)))
errs <- c(errs, "missing row names")
mode <- typeof(object)
if (mode == "list") {
mode <- unique.default(vapply(object, typeof, ""))
if (length(mode) > 1L)
errs <- c(errs, "non-uniform list elements contained")
if (any(lengths(object, FALSE) < 1L))
errs <- c(errs, "empty list elements contained")
}
mode <- setdiff(mode, c("character", "integer", "double", "logical"))
if (length(mode))
errs <- c(errs, sprintf("unsupported storage mode: '%s'", mode))
if (length(errs))
errs
else
TRUE
},
sealed = SEALED
)
setAs("OPM", "matrix", function(from) {
attach_attr(from, from@measurements)
})
setAs("OPM", "data.frame", function(from) {
attach_attr(from, as.data.frame(from@measurements))
})
setAs("OPM", "list", function(from) {
list(metadata = metadata(from), csv_data = as.list(csv_data(from)),
measurements = as.list(as.data.frame(measurements(from))))
})
setAs("list", "OPM", function(from) {
convert_measurements <- function(mat) {
mat <- must(do.call(cbind, lapply(mat, as.numeric)))
if (length(hour.pos <- which(colnames(mat) == HOUR)) != 1L)
stop("uninterpretable column names in list element 'measurements'")
sorted.names <- c(colnames(mat)[hour.pos],
sort.int(colnames(mat)[-hour.pos]))
mat[, sorted.names, drop = FALSE]
}
md <- repair_na_strings.list(as.list(from$metadata), "character")
new(Class = "OPM", csv_data = map_names(unlist(from$csv_data), rescue_dots),
metadata = map_names(md, rescue_dots),
measurements = convert_measurements(from$measurements))
})
setAs("OPMA", "matrix", function(from) {
attach_attr(from, from@measurements)
})
setAs("OPMA", "data.frame", function(from) {
attach_attr(from, as.data.frame(from@measurements))
})
setAs("OPMA", "list", function(from) {
result <- as(as(from, "OPM"), "list")
result$aggregated <- apply(aggregated(from), 2L, as.list)
result$aggr_settings <- aggr_settings(from)
result
})
setAs("list", "OPMA", function(from) {
select_aggr <- function(x, wanted) {
x <- repair_na_strings(lapply(x, `[`, unlist(map_param_names())))
x <- do.call(cbind, x[wanted])
must(mode(x) <- "numeric")
x # should now be matrix, reduced to the known wells, parameters and CIs
}
x <- as(from, "OPM")
new(Class = "OPMA", measurements = measurements(x),
csv_data = csv_data(x), metadata = metadata(x),
aggregated = select_aggr(from$aggregated, colnames(x@measurements)[-1L]),
aggr_settings = update_settings_list(as.list(from$aggr_settings)))
})
setAs("OPMD", "matrix", function(from) {
attach_attr(from, from@measurements)
})
setAs("OPMD", "data.frame", function(from) {
attach_attr(from, as.data.frame(from@measurements))
})
setAs("OPMD", "list", function(from) {
result <- as(as(from, "OPMA"), "list")
result$discretized <- as.list(from@discretized)
result$disc_settings <- from@disc_settings
result
})
setAs("list", "OPMD", function(from) {
# up to official release opm 0.10.0, the discretized curve parameter had
# not been included in the discretization settings
repair_missing_parameter <- function(x) {
if (x[[SOFTWARE]] != opm_string())
return(x)
if (is.null(x[[c(OPTIONS, "parameter")]])) {
warning("assuming discretized parameter is opm_opt('curve.param')")
x[[c(OPTIONS, "parameter")]] <- opm_opt("curve.param")
}
x
}
x <- as(from, "OPMA")
settings <- update_settings_list(as.list(from$disc_settings))
settings <- repair_missing_parameter(settings)
discretized <- from$discretized[colnames(x@aggregated)]
discretized <- unlist(repair_na_strings(discretized, "logical"))
new(Class = "OPMD", csv_data = csv_data(x), measurements = measurements(x),
metadata = metadata(x), aggr_settings = aggr_settings(x),
aggregated = aggregated(x), discretized = discretized,
disc_settings = settings)
})
setAs("OPMS", "list", function(from) {
lapply(from@plates, as, "list")
})
setAs("list", "OPMS", function(from) {
opmd.slots <- setdiff(slotNames("OPMD"), opma.slots <- slotNames("OPMA"))
opma.slots <- setdiff(opma.slots, slotNames("OPM"))
new(Class = "OPMS", plates = lapply(from, function(x) {
as(x, if (all(opma.slots %in% names(x)))
if (all(opmd.slots %in% names(x)))
"OPMD"
else
"OPMA"
else
"OPM")
}))
})
setAs("list", "MOPMX", function(from) {
new("MOPMX", from) # overwritten to enforce consistency checks
})
setAs("OPMX", "MOPMX", function(from) {
x <- new("MOPMX", list(from))
names(x) <- plate_type(from)
x
})
setAs("MOPMX", "OPMX", function(from) {
if (length(from) != 1L)
stop("conversion impossible: number of elements is not 1")
from[[1L]]
})
setAs("matrix", "CMAT", function(from) {
new("CMAT", from) # overwritten to enforce consistency checks
})
setClass("OPM_DB",
contains = "DBTABLES",
slots = c(plates = "data.frame", wells = "data.frame",
measurements = "data.frame"),
prototype = list(plates = data.frame(id = integer(), machine_id = integer()),
wells = data.frame(id = integer(), plate_id = integer()),
measurements = data.frame(id = integer(), well_id = integer())),
validity = fkeys_valid,
sealed = SEALED
)
setClass("OPMA_DB",
contains = "OPM_DB",
# the superclass slots must be repeated here to enforce the ordering
slots = c(plates = "data.frame", wells = "data.frame",
measurements = "data.frame", aggr_settings = "data.frame",
aggregated = "data.frame"),
prototype = list(plates = data.frame(id = integer(), machine_id = integer()),
wells = data.frame(id = integer(), plate_id = integer()),
measurements = data.frame(id = integer(), well_id = integer()),
aggr_settings = data.frame(id = integer(), plate_id = integer()),
aggregated = data.frame(id = integer(), well_id = integer(),
aggr_setting_id = integer())),
validity = fkeys_valid,
sealed = SEALED
)
setClass("OPMD_DB",
contains = "OPMA_DB",
# the superclass slots must be repeated here to enforce the ordering
slots = c(plates = "data.frame", wells = "data.frame",
measurements = "data.frame", aggr_settings = "data.frame",
aggregated = "data.frame", disc_settings = "data.frame",
discretized = "data.frame"),
prototype = list(plates = data.frame(id = integer(), machine_id = integer()),
wells = data.frame(id = integer(), plate_id = integer()),
measurements = data.frame(id = integer(), well_id = integer()),
aggr_settings = data.frame(id = integer(), plate_id = integer()),
aggregated = data.frame(id = integer(), well_id = integer(),
aggr_setting_id = integer()),
disc_settings = data.frame(id = integer(), plate_id = integer()),
discretized = data.frame(id = integer(), well_id = integer(),
disc_setting_id = integer())),
validity = fkeys_valid,
sealed = SEALED
)
setAs("OPM", "OPMA", function(from) {
stop("do_aggr() is needed to aggregate OPM objects")
})
setAs("OPM", "OPMD", function(from) {
stop("do_aggr() and do_disc() are needed to discretise OPM objects")
})
setAs("OPMA", "OPMD", function(from) {
stop("do_disc() is needed to discretise OPMA objects")
})
setAs("OPM", "OPM_DB", function(from) {
x <- forward_OPM_to_list(from)
new(Class = "OPM_DB", plates = x$plates, wells = x$wells,
measurements = x$measurements)
})
setAs("OPM_DB", "OPM", function(from) {
as(backward_OPM_to_list(from), "OPM")
})
setAs("OPMA", "OPMA_DB", function(from) {
x <- forward_OPMA_to_list(from)
new(Class = "OPMA_DB", plates = x$plates, wells = x$wells,
measurements = x$measurements, aggr_settings = x$aggr_settings,
aggregated = x$aggregated)
})
setAs("OPMA_DB", "OPMA", function(from) {
as(backward_OPMA_to_list(from), "OPMA")
})
setAs("OPMD", "OPMD_DB", function(from) {
x <- forward_OPMA_to_list(from)
d.sets <- settings_forward(from@disc_settings, x$plates[, "id"])
d.data <- from@discretized
storage.mode(d.data) <- "integer" # RMySQL might otherwise set all to FALSE
d.data <- data.frame(id = seq_along(d.data), stringsAsFactors = FALSE,
well_id = match(names(d.data), x$wells[, "coordinate"]),
disc_setting_id = 1L, value = unname(d.data), check.names = FALSE)
new(Class = "OPMD_DB", plates = x$plates, wells = x$wells,
measurements = x$measurements, aggr_settings = x$aggr_settings,
aggregated = x$aggregated, disc_settings = d.sets, discretized = d.data)
})
setAs("OPMD_DB", "OPMD", function(from) {
as(backward_OPMD_to_list(from), "OPMD")
})
setAs("list", "OPM_DB", function(from) {
do.call(c, rapply(object = from, f = as, Class = "OPM_DB"))
})
setAs("list", "OPMA_DB", function(from) {
do.call(c, rapply(object = from, f = as, Class = "OPMA_DB"))
})
setAs("list", "OPMD_DB", function(from) {
do.call(c, rapply(object = from, f = as, Class = "OPMD_DB"))
})
setAs("OPM_DB", "list", function(from) {
lapply(split(from), as, "OPM")
})
setAs("OPMA_DB", "list", function(from) {
lapply(split(from), as, "OPMA")
})
setAs("OPMD_DB", "list", function(from) {
lapply(split(from), as, "OPMD")
})
setAs("OPMS", "OPM_DB", function(from) {
do.call(c, lapply(from@plates, as, "OPM_DB"))
})
setAs("OPMS", "OPMA_DB", function(from) {
do.call(c, lapply(from@plates, as, "OPMA_DB"))
})
setAs("OPMS", "OPMD_DB", function(from) {
do.call(c, lapply(from@plates, as, "OPMD_DB"))
})
setAs("OPM_DB", "OPMS", function(from) {
as(lapply(split(from), backward_OPM_to_list), "OPMS")
})
setAs("OPMA_DB", "OPMS", function(from) {
as(lapply(split(from), backward_OPMA_to_list), "OPMS")
})
setAs("OPMD_DB", "OPMS", function(from) {
as(lapply(split(from), backward_OPMD_to_list), "OPMS")
})
setAs("MOPMX", "OPM_DB", function(from) {
do.call(c, lapply(unname(from), as, "OPM_DB"))
})
setAs("MOPMX", "OPMA_DB", function(from) {
do.call(c, lapply(unname(from), as, "OPMA_DB"))
})
setAs("MOPMX", "OPMD_DB", function(from) {
do.call(c, lapply(unname(from), as, "OPMD_DB"))
})
setAs("OPM_DB", "MOPMX", function(from) {
do.call(opms, c(as(from, "list"),
list(precomputed = TRUE, skip = FALSE, group = TRUE)))
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.