Commit 66119892 authored by arsenij.ustjanzew's avatar arsenij.ustjanzew
Browse files

add first phase of dimension reduction template and the validation function for it

parent 5e67408a
#' Renders a Sequence saturation plot
#'
#' @param object A \linkS4class{i2dash::i2dashboard} object.
#' @param red_dim List with reduced dimensions as data.frames.
#' @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
sequence_saturation <- function(object, red_dim, colour_by = NULL, title = "Reduced dimensions plot") {
# Create random env id
env_id <- paste0("env_", stringi::stri_rand_strings(1, 6, pattern = "[A-Za-z0-9]"))
# validate input, create environment variables, save environment object
.validate_input_sequence_saturation(object@workdir, env_id, red_dim, colour_by)
timestamp <- Sys.time()
expanded_component <- knitr::knit_expand(file = system.file("templates", "reduced_dimensions_template.Rmd", package = "i2dash.scrnaseq"), title = title, env_id = env_id, date = timestamp)
return(expanded_component)
}
.validate_input_sequence_saturation <- function(workdir, env_id, red_dim, colour_by) {
env <- new.env()
env$red_dim_selection <- FALSE
env$colour_by_selection <- FALSE
# Create lists if needed
if(!is.list(red_dim)) red_dim <- list(red_dim = red_dim)
if(!is.list(colour_by) & !is.null(colour_by)) colour_by <- list(colour_by)
# Check validity
if(!all(sapply(red_dim, is.data.frame))) stop("red_dim should only contain data.frame elements.")
# Add objects to env
env$red_dim <- red_dim
env$red_dim_selection <- length(env$red_dim) > 1
env$colour_by <- colour_by
env$colour_by_selection <- length(env$colour_by) > 1
# save environment as rds-object
saveRDS(env, file = file.path(workdir, "envs", paste0(env_id, ".rds")))
print("validation TRUE")
}
### {{ title }}
<!-- Component created on {{ date }} -->
```{r}
{{ env_id }} = readRDS("envs/{{ env_id }}.rds")
is_shiny <- identical(knitr::opts_knit$get("rmarkdown.runtime"), "shiny")
```
```{r, eval=!is_shiny}
x_value <- {{ env_id }}$x[[1]]
x_title <- names({{ env_id }}$x[1])
y_value <- {{ env_id }}$y[[1]]
y_title <- names({{ env_id }}$y[1])
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)
} else {
df <- data.frame({{ env_id }}$x, {{ env_id }}$y)
}
# devtools::install_github('yihui/xfun')
# embed_file() requires a few more packages
xfun::pkg_load2(c('base64enc', 'htmltools', 'mime'))
embed_var = function(x, ...) {
f = tempfile(fileext = '.csv')
write.csv(x, f)
xfun::embed_file(f, text = 'Download full data as .csv', ...)
}
# download_link
embed_var(df)
p <- plotly::plot_ly(data.frame(x_value, y_value, colour_value = I("black")),
x = x_value,
y = y_value,
color = colour_value
)
p <- plotly::layout(p,
xaxis = list(title = x_title),
yaxis = list(title = y_title))
p
```
```{r, eval=is_shiny}
ui_list <- list()
# selection field for x
if ({{ env_id }}$x_selection){
ui_list <- rlist::list.append(ui_list,
selectInput("select_x_{{ env_id }}", label = "Select data for x axis:",
choices = names({{ env_id }}$x)))
}
# 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)))
}
# 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)))
}
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 }}$x_selection){
x_value <- {{ env_id }}$x[[1]]
x_title <- names({{ env_id }}$x)
} else {
x_value <- {{ env_id }}$x[[input$select_x_{{ env_id }}]]
x_title <- input$select_x_{{ env_id }}
}
if (!{{ env_id }}$y_selection){
y_value <- {{ env_id }}$y[[1]]
y_title <- names({{ env_id }}$y)
} else {
y_value <- {{ env_id }}$y[[input$select_y_{{ env_id }}]]
y_title <- input$select_y_{{ env_id }}
}
if (!{{ env_id }}$colour_by_selection){
colour_value <- {{ env_id }}$colour_by[[1]]
} else {
colour_value <- {{ env_id }}$colour_by[[input$select_colour_{{ env_id }}]]
}
p <- plotly::plot_ly(data.frame(x_value, y_value, colour_value = I("black")),
x = x_value,
y = y_value,
color = colour_value
)
p <- plotly::layout(p,
xaxis = list(title = x_title),
yaxis = list(title = y_title))
p
})
```
***
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