Commit 7bdd4630 authored by arsenij.ustjanzew's avatar arsenij.ustjanzew
Browse files

resolved merge conflict

Merge branch 'violin_plot' into demo

# Conflicts:
#	NAMESPACE
#	R/visualization_functions.R
parents f86bd531 9b50b56c
......@@ -8,5 +8,7 @@ export(create_barplot_df)
export(plotly_barplot)
export(plotly_boxplot)
export(plotly_scatterplot)
export(create_violinplot_df)
export(plotly_violinplot)
importFrom(magrittr,"%<>%")
importFrom(magrittr,"%>%")
#' Renders a features by factor violin plot
#'
#' @param object A \linkS4class{i2dash::i2dashboard} object.
#' @param title A title that will be displayed on top.
#' @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
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]"))
# validate input, create environment variables, save environment object
.validate_input_features_by_factors(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.scrnaseq"), title = title, env_id = env_id, date = timestamp)
return(expanded_component)
}
.validate_input_features_by_factors <- function(workdir, env_id, x, y) {
env <- new.env()
env$x_selection <- FALSE
env$y_selection <- FALSE
# 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(y, is.numeric))) stop("y should only contain numeric values.")
if(!all(sapply(x, is.factor))) stop("x 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(workdir, "envs", paste0(env_id, ".rds")))
print("validation TRUE")
}
#' Renders a vertical violin plot
#'
#' @param object A \linkS4class{i2dash::i2dashboard} object.
#' @param y A vector with numerical values or a named list, which represents the observations for the vertical violinplot (y-axis). In case of a named list, a dropdown menu will be provided in the interactive mode.
#' @param group_by (Optional) A vector with factorial values or characters or a named list, which will be used for grouping the observations. In case of a named list, a dropdown menu will be provided in the interactive mode.
#' @param title (Optional) The title of the components junk.
#' @param title_y (Optional) The title of the y-axis that describes the observations. In case of a named list this parameter is not needed because the names of the list will be used as title of the y axis.
#' @param title_group_by (Optional) The title of the x-axis that describes the grouping factor. In case of a named list this parameter is not needed because the names of the list will be used as title of the x axis.
#'
#' @return A string containing markdown code for the rendered component
violinplot <- function(object, y, group_by = NULL, title = NULL, title_y = NULL, title_group_by = NULL) {
# Create random env id
env_id <- paste0("env_", stringi::stri_rand_strings(1, 6, pattern = "[A-Za-z0-9]"))
# Create list if element is not a list already
if(!is.list(y)) y <- list(y = y)
if(!is.list(group_by) & !is.null(group_by)) group_by <- list(group_by)
# Validate input
if(!all(sapply(y, is.numeric))) stop("'y' should only contain numerical values.")
if(any(sapply(group_by, is.character)) & !is.null(group_by)){
clust_names <- names(group_by[sapply(group_by, class) == 'character'])
for (name in clust_names){
group_by[[name]] <- as.factor(group_by[[name]])
}
}
if(!all(sapply(group_by, is.factor)) & !is.null(group_by)) stop("'group_by' should only contain factorial values.")
# Create component environment
env <- new.env()
env$y_selection <- FALSE
env$group_by_selection <- FALSE
env$y <- y
env$y_selection <- length(env$y) > 1
env$group_by <- group_by
env$group_by_selection <- length(env$group_by) > 1
env$title_y <- title_y
env$title_group_by <- title_group_by
# save environment object
saveRDS(env, file = file.path(object@workdir, "envs", paste0(env_id, ".rds")))
# Expand component
timestamp <- Sys.time()
expanded_component <- knitr::knit_expand(file = system.file("templates", "violinplot.Rmd", package = "i2dash.scrnaseq"), title = title, env_id = env_id, date = timestamp)
return(expanded_component)
}
......@@ -119,3 +119,54 @@ plotly_boxplot <- function(df, ..., title_x = NULL, title_group_by = NULL){
showlegend = F)
}
#' Function to create a dataframe for plotly_violinplot.
#'
#' @param y A list with the observations for the violinplot.
#' @param group_by (Optional) A list with factorial values, by which observations can optionally be grouped.
#' @param title_y (Optional) The title of the y-axis that describes the observations.
#' @param title_group_by (Optional) The title of the x-axis that describes the grouping factor.
#'
#' @return An object of class \code{list} containig the dataframe 'df', the vector 'x' with values for the x-axis, the vector 'y' with values for the y-axis, the vector 'split', the boolean value 'showlegend', the character string "title_y", the character string "title_group_by".
#' @export
create_violinplot_df <- function(y, group_by = NULL, title_y = NULL, title_group_by = NULL){
# create data_frame
if(is.null(group_by)){
df <- data.frame(y)
} else {
df <- data.frame(y, group_by)
}
# manage the titles of axis
if(is.null(title_y)) title_y <- names(df[1]) else title_y <- title_y
if(is.null(title_group_by) & !is.null(group_by)) title_group_by <- names(df[2]) else title_group_by <- title_group_by
# set variables in dependence of 'group_by'
if (is.null(group_by)) {
x <- NULL
showlegend <- F
} else {
x <- df[[2]]
showlegend <- T
}
return(list("df"=df, "x"=x, "y"=df[[1]], "split"=x, "showlegend"=showlegend, "title_y"=title_y, "title_group_by"=title_group_by))
}
#' Render a vertical violin plot with plotly.
#'
#' @param ... these arguments are of either the form value or tag = value and should be valid for the 'plotly::plot_ly()' method.
#' @param showlegend Boolean value that describes if the legend should be shown.
#' @param title_y (Optional) The title of the y-axis that describes the observations.
#' @param title_group_by (Optional) The title of the x-axis that describes the grouping factor.
#'
#' @return An object of class \code{plotly}.
#' @export
plotly_violinplot <- function(..., showlegend = F, title_y = NULL, title_group_by = NULL){
plotly::plot_ly(..., type = 'violin',
box = list(visible = T),
meanline = list(visible = T)) %>%
plotly::layout(xaxis = list(title = title_group_by, showline = T),
yaxis = list(title = title_y, showline = T),
showlegend = showlegend)
}
### {{ 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)
y_value <- {{ env_id }}$y[[1]]
y_title <- names({{ env_id }}$y)
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, 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)))
}
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 }}
}
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
})
```
***
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}
{{ env_id }} = readRDS("envs/{{ env_id }}.rds")
is_shiny <- identical(knitr::opts_knit$get("rmarkdown.runtime"), "shiny")
```
```{r, eval=!is_shiny}
# Function to create a dataframe for bar plot
output_list <- i2dash.scrnaseq::create_violinplot_df(y = {{ env_id }}$y[1], group_by = {{ env_id }}$group_by[1], title_y = {{ env_id }}$title_y, title_group_by = {{ env_id }}$title_group_by)
# Provide data download
i2dash::embed_var(output_list$df)
# Render plot
i2dash.scrnaseq::plotly_violinplot(x = output_list$x, y = output_list$y, split = output_list$split, showlegend = output_list$showlegend, title_y = output_list$title_y, title_group_by = output_list$title_group_by)
```
```{r, eval=is_shiny}
ui_list <- list()
# selection field for y
if ({{ env_id }}$y_selection){
ui_list <- rlist::list.append(ui_list,
selectInput("select_y_{{ env_id }}", label = "Select observations:",
choices = names({{ env_id }}$y)))
}
# selection field for group_by
if ({{ env_id }}$group_by_selection){
ui_list <- rlist::list.append(ui_list,
selectInput("select_group_by_{{ env_id }}", label = "Group observations by:",
choices = names({{ env_id }}$group_by)))
}
# download_link
ui_list <- rlist::list.append(ui_list, tags$div(tags$br(), downloadButton('downloadData_{{ env_id }}', 'Download data')))
#
# Create reactive method
#
df_{{ env_id }} <- shiny::reactive({
if( !{{ env_id }}$y_selection ) {
y <- {{ env_id }}$y[1]
} else {
y <- {{ env_id }}$y[input$select_y_{{ env_id }}]
}
if( !{{ env_id }}$group_by_selection ) {
group_by <- {{ env_id }}$group_by[1]
} else {
group_by <- {{ env_id }}$group_by[input$select_group_by_{{ env_id }}]
}
return(i2dash.scrnaseq::create_violinplot_df(y = y, group_by = group_by, title_y = {{ env_id }}$title_y, title_group_by = {{ env_id }}$title_group_by))
})
#
# Download
#
output$downloadData_{{ env_id }} <- downloadHandler(
filename = paste('data-', Sys.Date(), '.csv', sep=''),
content = function(file) {
write.csv(df_{{ env_id }}()$df, file)
}
)
#
# Output
#
output$plot_{{ env_id }} <- plotly::renderPlotly(
i2dash.scrnaseq::plotly_violinplot(x = df_{{ env_id }}()$x, y = df_{{ env_id }}()$y, split = df_{{ env_id }}()$split, showlegend = df_{{ env_id }}()$showlegend, title_y = df_{{ env_id }}()$title_y, title_group_by = df_{{ env_id }}()$title_group_by)
)
#
# Layout of component junk
#
shiny::fillCol(flex = c(NA, 1),
do.call(shiny::inputPanel, ui_list),
plotly::plotlyOutput("plot_{{ env_id }}", height = "100%")
)
```
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/visualization_functions.R
\name{create_violinplot_df}
\alias{create_violinplot_df}
\title{Function to create a dataframe for plotly_violinplot.}
\usage{
create_violinplot_df(y, group_by = NULL, title_y = NULL,
title_group_by = NULL)
}
\arguments{
\item{y}{A list with the observations for the violinplot.}
\item{group_by}{(Optional) A list with factorial values, by which observations can optionally be grouped.}
\item{title_y}{(Optional) The title of the y-axis that describes the observations.}
\item{title_group_by}{(Optional) The title of the x-axis that describes the grouping factor.}
}
\value{
An object of class \code{list} containig the dataframe 'df', the vector 'x' with values for the x-axis, the vector 'y' with values for the y-axis, the vector 'split', the boolean value 'showlegend', the character string "title_y", the character string "title_group_by".
}
\description{
Function to create a dataframe for plotly_violinplot.
}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/features_by_factors.R
\name{features_by_factors}
\alias{features_by_factors}
\title{Renders a features by factor violin plot}
\usage{
features_by_factors(object, x, y, title = "Features by factor")
}
\arguments{
\item{object}{A \linkS4class{i2dash::i2dashboard} object.}
\item{x}{A list with the x-axis values. If it is a nested list, a dropdown-field will be provided in the interactive mode.}
\item{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.)}
\item{title}{A title that will be displayed on top.}
}
\value{
A string containing markdown code for the rendered textbox
}
\description{
Renders a features by factor violin plot
}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/visualization_functions.R
\name{plotly_violinplot}
\alias{plotly_violinplot}
\title{Render a vertical violin plot with plotly.}
\usage{
plotly_violinplot(..., showlegend = F, title_y = NULL,
title_group_by = NULL)
}
\arguments{
\item{...}{these arguments are of either the form value or tag = value and should be valid for the 'plotly::plot_ly()' method.}
\item{showlegend}{Boolean value that describes if the legend should be shown.}
\item{title_y}{(Optional) The title of the y-axis that describes the observations.}
\item{title_group_by}{(Optional) The title of the x-axis that describes the grouping factor.}
}
\value{
An object of class \code{plotly}.
}
\description{
Render a vertical violin plot with plotly.
}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/violinplot.R
\name{violinplot}
\alias{violinplot}
\title{Renders a vertical violin plot}
\usage{
violinplot(object, y, group_by = NULL, title = NULL, title_y = NULL,
title_group_by = NULL)
}
\arguments{
\item{object}{A \linkS4class{i2dash::i2dashboard} object.}
\item{y}{A vector with numerical values or a named list, which represents the observations for the vertical violinplot (y-axis). In case of a named list, a dropdown menu will be provided in the interactive mode.}
\item{group_by}{(Optional) A vector with factorial values or characters or a named list, which will be used for grouping the observations. In case of a named list, a dropdown menu will be provided in the interactive mode.}
\item{title}{(Optional) The title of the components junk.}
\item{title_y}{(Optional) The title of the y-axis that describes the observations. In case of a named list this parameter is not needed because the names of the list will be used as title of the y axis.}
\item{title_group_by}{(Optional) The title of the x-axis that describes the grouping factor. In case of a named list this parameter is not needed because the names of the list will be used as title of the x axis.}
}
\value{
A string containing markdown code for the rendered component
}
\description{
Renders a vertical violin plot
}
Markdown is supported
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