Commit 8b6e8865 authored by Ustjanzew's avatar Ustjanzew
Browse files

redone validate functions

parent 91e76371
......@@ -5,57 +5,39 @@
#' @param y A list with the y-axis values. If it is a nested list, a dropdown-field will be provided in the interactive mode.(Needs to be categorial. Horizontal violinplots are not possible.)
#'
#' @return A string containing markdown code for the rendered textbox
render_features_by_factors <- function(object, plot_title, x, y) {
features_by_factors <- function(object, x, y, title = "Features by factor") {
# Create random env id
env_id <- paste0("env_", stringi::stri_rand_strings(1, 6, pattern = "[A-Za-z0-9]"))
env_id <- .create_id()
# validate input, create environment variables, save environment object
.validate_input_ff(object, env_id, x, y)
.validate_input(object@workdir, env_id, x, y)
timestamp <- Sys.time()
expanded_component <- knitr::knit_expand(file = system.file("templates", "features_by_factors_template.Rmd", package = "i2dash"), plot_title = plot_title, env_id = env_id, date = timestamp)
expanded_component <- knitr::knit_expand(file = system.file("templates", "features_by_factors_template.Rmd", package = "i2dash"), title = title, env_id = env_id, date = timestamp)
return(expanded_component)
}
.create_id <- function(n = 1) {
a <- do.call(paste0, replicate(5, sample(LETTERS, n, TRUE), FALSE))
paste0(a, sprintf("%04d", sample(9999, n, TRUE)), sample(LETTERS, n, TRUE))
}
.validate_input_ff <- function(object, env_id, x, y) {
.validate_input <- function(workdir, env_id, x, y) {
env <- new.env()
env$x_selection <- FALSE
env$y_selection <- FALSE
# validate x and create environment variables
if(is.list(x) & length(x) == 1) {
if (is.factor(x[[1]])){
env$x <- x
} else {
stop("x should contain factors")
}
} else if (is.list(x) & length(x) > 1) {
for (i in length(x)){
if (is.factor(x[[i]])){
env$x_selection <- TRUE
env$x <- x
} else {
stop("x should contain only factors")
}
}
} else if (!is.list(x) | (is.list(x) & length(x) == 0)){
stop("x needs to be a named list with at least one element")
}
# validate y and create environment variables
if(is.list(y) & length(y) == 1) {
env$y <- y
} else if (is.list(y) & length(y) > 1) {
env$y_selection <- TRUE
env$y <- y
} else if (!is.list(y) | (is.list(y) & length(y) == 0)){
stop("y needs to be a named list with at least one element")
}
# Create lists if needed
if(!is.list(x)) x <- list(x = x)
if(!is.list(y)) y <- list(y = y)
# Check validity
if(!all(sapply(x, is.numeric))) stop("x should only contain numeric values.")
if(!all(sapply(y, is.numeric))) stop("y should only contain numeric values.")
if(!all(sapply(x, is.factor))) stop("y should only contain factorial values.")
# Add objects to env
env$x <- x
env$x_selection <- length(env$x) > 1
env$y <- y
env$y_selection <- length(env$y) > 1
# save environment as rds-object
saveRDS(env, file = file.path(object@workdir, "envs", sprintf("%s.rds", env_id)))
}
\ No newline at end of file
saveRDS(env, file = file.path(workdir, "envs", paste0(env_id, ".rds")))
}
......@@ -6,7 +6,7 @@
#' @param color_by A list with the color_by values. If it is a nested list, a dropdown-field will be provided in the interactive mode.
#'
#' @return A string containing markdown code for the rendered textbox
render_multiplot <- function(object, plot_title, x, y, color_by) {
multiplot <- function(object, plot_title, x, y, color_by) {
env_id <- .create_id()
# validate input, create environment variables, save environment object
......@@ -64,4 +64,4 @@ render_multiplot <- function(object, plot_title, x, y, color_by) {
# save environment as rds-object
saveRDS(env, file = file.path(object@workdir, "envs", sprintf("%s.rds", env_id)))
}
\ No newline at end of file
}
......@@ -3,11 +3,11 @@
#' @param object A \linkS4class{i2dash::i2dashboard} object.
#' @param x Numeric values mapped to the x-axis. In case of a nested list, a dropdown menu will be provided in the interactive mode.
#' @param y Numeric values mapped to the y-axis. In case of a nested list, a dropdown menu will be provided in the interactive mode.
#' @param coulor_by A factor that will be mapped to colors.In case of a nested list, a dropdown menu will be provided in the interactive mode.
#' @param coulor_by A factor that will be mapped to colours.In case of a nested list, a dropdown menu will be provided in the interactive mode.
#' @param title A title that will be displayed on top.
#'
#' @return A string containing markdown code for the rendered textbox
render_sequence_saturation <- function(object, x, y, colour_by = NULL, title = "Sequencing saturation") {
sequence_saturation <- function(object, x, y, colour_by = NULL, title = "Sequencing saturation") {
# Create random env id
env_id <- paste0("env_", stringi::stri_rand_strings(1, 6, pattern = "[A-Za-z0-9]"))
......@@ -15,7 +15,7 @@ render_sequence_saturation <- function(object, x, y, colour_by = NULL, title = "
.validate_input(object@workdir, env_id, x, y, colour_by)
timestamp <- Sys.time()
expanded_component <- knitr::knit_expand(file = system.file("templates", "sequence_saturation_template.Rmd", package = "i2dash"), title = title, env_id = env_id, date = timestamp)
expanded_component <- knitr::knit_expand(file = system.file("templates", "sequence_saturation_template.Rmd", package = "i2dash.scrnaseq"), title = title, env_id = env_id, date = timestamp)
return(expanded_component)
}
......@@ -46,4 +46,5 @@ render_sequence_saturation <- function(object, x, y, colour_by = NULL, title = "
# save environment as rds-object
saveRDS(env, file = file.path(workdir, "envs", paste0(env_id, ".rds")))
print("validation TRUE")
}
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment