Commit 5e67408a authored by arsenij.ustjanzew's avatar arsenij.ustjanzew
Browse files

remake of the validation function and the Rmd file for multiplot. Not debugged.

parent 62c30af5
......@@ -3,65 +3,46 @@
#' @param plot_title The title of the Component
#' @param x A list with the x-axis values. If it is a nested list, a dropdown-field will be provided in the interactive mode.
#' @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.
#' @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.
#' @param colour_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
multiplot <- function(object, plot_title, x, y, color_by) {
multiplot <- function(object, x, y, title = "Multiplot", colour_by = NULL) {
# 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(object, env_id, x, y, color_by)
.validate_input_multiplot(object@workdir, env_id, x, y, colour_by)
timestamp <- Sys.time()
expanded_component <- knitr::knit_expand(file = system.file("templates", "multiplot_template.Rmd", package = "i2dash"), plot_title = plot_title, env_id = env_id, date = timestamp)
expanded_component <- knitr::knit_expand(file = system.file("templates", "multiplot_template.Rmd", package = "i2dash.scrnaseq"), 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 <- function(object, env_id, x, y, color_by) {
.validate_input_multiplot <- function(workdir, env_id, x, y, colour_by) {
env <- new.env()
env$x_selection <- FALSE
env$y_selection <- FALSE
env$color_selection <- FALSE
env$colour_by_selection <- FALSE
# Create lists if needed
if(!is.list(x)) x <- list(x = x)
if(!is.list(y)) y <- list(y = y)
if(!is.list(colour_by) & !is.null(colour_by)) colour_by <- list(colour_by)
# Check validity
if(!all(sapply(x, is.numeric))) stop("x should only contain numeric values.")
if(!all(sapply(y, is.factor))) stop("y should only contain factorial values.")
# validate x and create environment variables
if(is.list(x) & length(x) == 1) {
env$x <- x
} else if (is.list(x) & length(x) > 1) {
env$x_selection <- TRUE
env$x <- x
} else if (!is.list(x) | (is.list(x) & length(x) == 0)){
stop("x needs to be a named list with at least one element")
}
# Add objects to env
env$x <- x
env$x_selection <- length(env$x) > 1
# 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")
}
env$y <- y
env$y_selection <- length(env$y) > 1
# validate color_by and create environment variables
if(is.list(color_by) & length(color_by) == 1) {
env$color_by <- color_by
} else if (is.list(color_by) & length(color_by) > 1) {
env$color_selection <- TRUE
env$color_by <- color_by
} else if (!is.list(color_by) | (is.list(color_by) & length(color_by) == 0)){
stop("color_by needs to be a named list with at least one element")
}
# for (i in color_by){
# if (!is.factor(i)){
# stop("color_by needs to be a list with factorial elements")
# }
# }
env$colour_by <- colour_by
env$colour_by_selection <- length(env$colour_by) > 1
# save environment as rds-object
saveRDS(env, file = file.path(object@workdir, "envs", sprintf("%s.rds", env_id)))
saveRDS(env, file = file.path(workdir, "envs", paste0(env_id, ".rds")))
}
### {{plot_title}}
### {{ title }}
<!-- Component created on {{ date }} -->
```{r}
{{ env_id }} = readRDS("envs/{{ env_id }}.rds")
df <- data.frame({{ env_id }}$x, {{ env_id }}$y, {{ env_id }}$color_by)
df.melted <- reshape::melt(df, id=c(names({{ env_id }}$y), names({{ env_id }}$color_by)))
plotly::plotlyOutput("plot_{{ env_id }}")
output$plot_{{ env_id }} <- plotly::renderPlotly({
is_shiny <- identical(knitr::opts_knit$get("rmarkdown.runtime"), "shiny")
```
if (!{{ env_id }}$y_selection){
index_y <- match(names({{ env_id }}$y), names(df.melted))
} else {
index_y <- match(input$select_y_{{ env_id }}, names(df.melted))
}
```{r, eval=!is_shiny}
if (!{{ env_id }}$color_selection){
index_color <- match(names({{ env_id }}$color_by), names(df.melted))
} else {
index_color <- match(input$select_color_{{ env_id }}, names(df.melted))
}
if(!is.null({{ env_id }}$colour_by)) {
colour_value <- {{ env_id }}$colour_by[[1]]
df <- data.frame({{ env_id }}$x, {{ env_id }}$y, {{ env_id }}$colour_by)
df.melted <- reshape::melt(df, id=c(names({{ env_id }}$y), names({{ env_id }}$colour_by)))
g1 <- ggplot2::ggplot(df.melted, mapping = ggplot2::aes(y = value, x = df.melted[,index_y], color = df.melted[,index_color])) +
ggplot2::geom_jitter() +
ggplot2::geom_violin(mapping = ggplot2::aes(y = value), scale = "count") +
ggplot2::facet_grid(. ~ variable, scales = "free_x") +
ggplot2::theme_bw() +
ggplot2::theme(panel.border = ggplot2::element_blank()) +
ggplot2::scale_colour_viridis_c() +
ggplot2::coord_flip() +
ggplot2::labs( y="Type", x="", color=names(df.melted)[index_color])
index_y <- match(names({{ env_id }}$y), names(df.melted))
index_colour <- match(names({{ env_id }}$colour_by), names(df.melted))
g1 <- ggplot2::ggplot(df.melted, mapping = ggplot2::aes(y = value, x = df.melted[,index_y[1]], color = df.melted[,index_colour[1]])) +
ggplot2::geom_jitter() +
ggplot2::geom_violin(mapping = ggplot2::aes(y = value), scale = "count") +
ggplot2::facet_grid(. ~ variable, scales = "free_x") +
ggplot2::theme_bw() +
ggplot2::theme(panel.border = ggplot2::element_blank()) +
ggplot2::scale_colour_viridis_c() +
ggplot2::coord_flip() +
ggplot2::labs( y="Type", x="", color=names(df.melted)[index_colour])
plotly::ggplotly(g1)
})
} else {
df <- data.frame({{ env_id }}$x, {{ env_id }}$y)
df.melted <- reshape::melt(df, id=c(names({{ env_id }}$y)))
index_y <- match(names({{ env_id }}$y), names(df.melted))
g1 <- ggplot2::ggplot(df.melted, mapping = ggplot2::aes(y = value, x = df.melted[,index_y[1]])) +
ggplot2::geom_jitter() +
ggplot2::geom_violin(mapping = ggplot2::aes(y = value), scale = "count") +
ggplot2::facet_grid(. ~ variable, scales = "free_x") +
ggplot2::theme_bw() +
ggplot2::theme(panel.border = ggplot2::element_blank()) +
ggplot2::coord_flip() +
ggplot2::labs( y="Type", x="")
plotly::ggplotly(g1)
}
```
***
```{r, eval=is_shiny}
ui_list <- list()
```{r}
# selection field for y
if ({{ env_id }}$y_selection){
ui_list <- rlist::list.append(ui_list,
selectInput("select_y_{{ env_id }}", label = "Select data for y axis:",
choices = names({{ env_id }}$y))
choices = names({{ env_id }}$y)))
}
# selection field for color_by
if ({{ env_id }}$color_selection){
selectInput("select_color_{{ env_id }}", label = "Select experimental factor for coloring:",
choices = names({{ env_id }}$color_by))
# selection field for colour_by
if ({{ env_id }}$colour_by_selection){
ui_list <- rlist::list.append(ui_list,
selectInput("select_colour_{{ env_id }}", label = "Select colouring:",
choices = names({{ env_id }}$colour_by)))
}
# create dataframe
if(!is.null({{ env_id }}$colour_by)) {
colour_value <- {{ env_id }}$colour_by[[1]]
df <- data.frame({{ env_id }}$x, {{ env_id }}$y, {{ env_id }}$colour_by)
df.melted <- reshape::melt(df, id=c(names({{ env_id }}$y), names({{ env_id }}$colour_by)))
} else {
df <- data.frame({{ env_id }}$x, {{ env_id }}$y)
df.melted <- reshape::melt(df, id=c(names({{ env_id }}$y)))
}
#print(names(df.melted))
fillCol(flex = c(NA, 1),
do.call("inputPanel", ui_list),
plotly::plotlyOutput("plot_{{ env_id }}", height = "100%"))
output$plot_{{ env_id }} <- plotly::renderPlotly({
if (!{{ env_id }}$y_selection){
index_y <- match(names({{ env_id }}$y), names(df.melted))
} else {
index_y <- match(input$select_y_{{ env_id }}, names(df.melted))
}
if (is.null({{ env_id }}$colour_by)) {
g1 <- ggplot2::ggplot(df.melted, mapping = ggplot2::aes(y = value, x = df.melted[,index_y[1]])) +
ggplot2::geom_jitter() +
ggplot2::geom_violin(mapping = ggplot2::aes(y = value), scale = "count") +
ggplot2::facet_grid(. ~ variable, scales = "free_x") +
ggplot2::theme_bw() +
ggplot2::theme(panel.border = ggplot2::element_blank()) +
ggplot2::scale_colour_viridis_c() +
ggplot2::coord_flip() +
ggplot2::labs( y="Type", x="")
plotly::ggplotly(g1)
} else {
if (!{{ env_id }}$colour_by_selection){
index_colour <- match(names({{ env_id }}$colour_by), names(df.melted))
} else {
index_colour <- match(input$select_colour_{{ env_id }}, names(df.melted))
}
g1 <- ggplot2::ggplot(df.melted, mapping = ggplot2::aes(y = value, x = df.melted[,index_y[1]], color = df.melted[,index_colour[1]])) +
ggplot2::geom_jitter() +
ggplot2::geom_violin(mapping = ggplot2::aes(y = value), scale = "count") +
ggplot2::facet_grid(. ~ variable, scales = "free_x") +
ggplot2::theme_bw() +
ggplot2::theme(panel.border = ggplot2::element_blank()) +
ggplot2::scale_colour_viridis_c() +
ggplot2::coord_flip() +
ggplot2::labs( y="Type", x="", color=names(df.melted)[index_colour])
plotly::ggplotly(g1)
}
})
```
***
Plot description:
Sequencing is called *saturated* when generating more sequencing output from a cDNA library does not substantially increase the number of detected features in a sample. Since the number of detected features can act as a technical confounder, and thereby drive substructure in the data, it is advisable to aim for a saturated sequencing by either adding more sequencing output or decreasing the number of samples until saturation is achieved. [@zhang_one_2018] gives advise on how to choose the optimal cell number given a fixed sequencing budget
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