Commit 404e5e07 authored by jens.preussner's avatar jens.preussner 👻
Browse files

Initial commit, added components from parent i2dash

parents
^i2dash\.Rproj$
^\.Rproj\.user$
.Rproj.user
.Rhistory
.RData
.Ruserdata
Package: i2dash.scrnaseq
Type: Package
Title: Iterative and Interactive Dashboards in R
Version: 0.0.0.9000
Authors@R: c(
person(given = "Arsenij", family = "Ustjanzew", email = "arsenij.ustjanzews@mpi-bn.mpg.de", role = c("aut", "cre")),
person(given = "Jens", family = "Preussner", email = "jens.preussner@mpi-bn.mpg.de", role = c("aut"), comment = c(ORCID = "0000-0003-1927-3458")),
person(given = "Mario", family = "Looso", email = "mario.looso@mpi-bn.mpg.de", role = "aut"))
Description: What the package does (one paragraph).
Depends: R (>= 3.5.2)
License: What license is it under?
Encoding: UTF-8
LazyData: true
# Generated by roxygen2: fake comment so roxygen2 overwrites silently.
exportPattern("^[^\\.]")
#' Renders a features by factor violin plot
#'
#' @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.(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) {
env_id <- .create_id()
# validate input, create environment variables, save environment object
.validate_input_ff(object, 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)
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) {
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")
}
# save environment as rds-object
saveRDS(env, file = file.path(object@workdir, "envs", sprintf("%s.rds", env_id)))
}
\ No newline at end of file
#' Renders a Sequence saturation plot
#'
#' @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.
#'
#' @return A string containing markdown code for the rendered textbox
render_multiplot <- function(object, plot_title, x, y, color_by) {
env_id <- .create_id()
# validate input, create environment variables, save environment object
.validate_input(object, env_id, x, y, color_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)
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) {
env <- new.env()
env$x_selection <- FALSE
env$y_selection <- FALSE
env$color_selection <- FALSE
# 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")
}
# 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")
}
# 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")
# }
# }
# save environment as rds-object
saveRDS(env, file = file.path(object@workdir, "envs", sprintf("%s.rds", env_id)))
}
\ No newline at end of file
#' Renders a Sequence saturation plot
#'
#' @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 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") {
# 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(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)
return(expanded_component)
}
.validate_input <- function(workdir, env_id, x, y, colour_by) {
env <- new.env()
env$x_selection <- FALSE
env$y_selection <- FALSE
env$colour_by_selection <- FALSE
# Create lists if needed
if(!is.list(x)) x <- list(x)
if(!is.list(y)) y <- list(y)
if(!is.list(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.numeric))) stop("y should only contain numeric 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
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")))
}
\ No newline at end of file
Version: 1.0
RestoreWorkspace: Default
SaveWorkspace: Default
AlwaysSaveHistory: Default
EnableCodeIndexing: Yes
UseSpacesForTab: Yes
NumSpacesForTab: 2
Encoding: UTF-8
RnwWeave: Sweave
LaTeX: pdfLaTeX
AutoAppendNewline: Yes
StripTrailingWhitespace: Yes
### {{plot_title}}
<!-- Page created on {{ date }} -->
```{r}
{{ env_id }} = readRDS("envs/{{ env_id }}.rds")
plotly::plotlyOutput("plot_{{ env_id }}")
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 }}
}
p <- plotly::plot_ly(data.frame(x_value, y_value),
x = x_value,
y = y_value,
split = x_value,
type = 'violin',
box = list(
visible = T
),
meanline = list(
visible = T
)
)
p <- plotly::layout(p,
xaxis = list(title = x_title),
yaxis = list(title = y_title,
zeroline = F))
p
})
```
***
```{r}
# selection field for x
if ({{ env_id }}$x_selection){
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){
selectInput("select_y_{{ env_id }}", label = "Select data for y axis:",
choices = names({{ env_id }}$y))
}
```
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
### {{plot_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({
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 (!{{ 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))
}
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])
plotly::ggplotly(g1)
})
```
***
```{r}
# selection field for y
if ({{ env_id }}$y_selection){
selectInput("select_y_{{ env_id }}", label = "Select data for y axis:",
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))
}
```
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
### {{ title }}
<!-- Component created on {{ date }} -->
```{r setup}
{{ env_id }} = readRDS("envs/{{ env_id }}.rds")
is_shiny <- identical(knitr::opts_knit$get("rmarkdown.runtime"), "shiny")
```
```{r, eval=!is_shiny}
if(!is.null({{ env_id }}$colour_by)) {
data <- data.frame(x = {{ env_id }}$x[[1]], y = {{ env_id }}$y[[1]], colour_by = {{ env_id }}$colour_by[[1]])
highcharter::hchart(data, "scatter", highcharter::hcaes(x = x, y = y, group = colour_by))
} else {
data <- data.frame(x = {{ env_id }}$x[[1]], y = {{ env_id }}$y[[1]])
highcharter::hchart(data, "scatter", highcharter::hcaes(x = x, y = y))
}
```
```{r, eval=is_shiny}
plotly::plotlyOutput("plot_{{ env_id }}")
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 }}$color_selection){
color_value <- {{ env_id }}$color_by[[1]]
} else {
color_value <- {{ env_id }}$color_by[[input$select_color_{{ env_id }}]]
}
p <- plotly::plot_ly(data.frame(x_value, y_value, color_value),
x = x_value,
y = y_value,
color = color_value
)
p <- plotly::layout(p,
xaxis = list(title = x_title),
yaxis = list(title = y_title))
p
})
```
***
```{r, eval=is_shiny}
# selection field for x
if ({{ env_id }}$x_selection){
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){
selectInput("select_y_{{ env_id }}", label = "Select data for y axis:",
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))
}
```
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