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

resolved merge conflict

Merge branch 'scatterplot' into demo

# Conflicts:
#	NAMESPACE
parents 0069b11f 94a0f97c
......@@ -2,11 +2,11 @@
export("%<>%")
export("%>%")
export(.scatter_plot)
export(barplot)
export(boxplot)
export(create_barplot_df)
export(plotly_barplot)
export(plotly_boxplot)
export(plotly_scatterplot)
importFrom(magrittr,"%<>%")
importFrom(magrittr,"%>%")
#' Renders a Sequence saturation plot
#' Renders a scatter 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 colour_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 labels A list with sample names, that should be of the same length as x and y.
#' @param title A title that will be displayed on top.
#' @param x A vector with numerical values or a named list will be mapped to the x-axis. In case of a named list, a dropdown menu will be provided in the interactive mode. Note: The length of vectors x and y should be the same as well as the length of all vectors in case of a named list.
#' @param y A vector with numerical values or a named list will be mapped to the y-axis. In case of a named list, a dropdown menu will be provided in the interactive mode. Note: The length of vectors x and y should be the same as well as the length of all vectors in case of a named list.
#' @param colour_by (Optional) A vector with factorial values or a named list will be used for colouring. In case of a named list, a dropdown menu will be provided in the interactive mode. Note: The length of the vector should be of the same length as x and y as well as the length of all vectors in case of a named list.
#' @param labels (Optional) A vector or list with sample names (numeric or characters). A dropdown menu for colouring by label will be provided. Note: The length of the vector should be of the same length as x and y.
#' @param expression (Optional) A matrix or dataframe with the same length of columns as 'x'. The sequence of the columns should be equal to the sequence in 'x'. The rownames represent the feature i.e. gene names and the values represent the expression level.
#' @param title (Optional) The title of the components junk.
#'
#' @return A string containing markdown code for the rendered textbox
sequence_saturation <- function(object, x, y, colour_by = NULL, labels = NULL, title = "Sequencing saturation") {
scatterplot <- function(object, x, y, colour_by = NULL, labels = NULL, expression = NULL, title = NULL) {
# 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, x, y, colour_by, labels)
timestamp <- Sys.time()
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)
}
.validate_input_sequence_saturation <- function(workdir, env_id, x, y, colour_by, labels) {
env <- new.env()
env$x_selection <- FALSE
env$y_selection <- FALSE
env$colour_by_selection <- FALSE
# Create lists if needed
# Create list if element is not a list already
if(!is.list(x)) x <- list(x)
if(!is.list(y)) y <- list(y)
if(!is.list(colour_by) & !is.null(colour_by)) colour_by <- list(colour_by)
if(!is.list(labels) & !is.null(labels)) labels <- list(labels)
# should I use magrittr::%<>% ?
# name the lists
library(magrittr)
# Name the lists
if(is.null(names(x))) x %<>% magrittr::set_names("x")
if(is.null(names(y))) y %<>% magrittr::set_names("y")
if(is.null(names(colour_by)) & !is.null(colour_by)) colour_by %<>% magrittr::set_names("colour")
if(is.null(names(labels)) & !is.null(labels)) labels %<>% magrittr::set_names("labels")
# Check existence of x and y
if(is.null(x)) stop("x is required.")
if(is.null(y)) stop("y is required.")
# Validate input
if(!all(sapply(x, is.numeric))) stop("'x' should only contain numerical values.")
if(!all(sapply(y, is.numeric))) stop("'y' should only contain numerical values.")
if((!is.matrix(expression) & !is.data.frame(expression)) & !is.null(expression)) stop("'expression' should be a class of 'matrix' or 'data.frame'.")
# 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.")
# Check, if lengths in a list are the same and if x and y and label and color_by are the same length
if(length(unique(sapply(x, length))) != 1) stop("The list 'x' should contain elements with the same length.")
if(length(unique(sapply(y, length))) != 1) stop("The list 'y' should contain elements with the same length.")
if(length(unique(sapply(colour_by, length))) != 1 & !is.null(colour_by)) stop("The list 'colour_by' should contain elements with the same length.")
if(length(unique(sapply(labels, length))) != 1 & !is.null(labels)) stop("The list 'labels' should contain elements with the same length.")
# Check if lengths in a list are the same and if x and y and label and color_by are the same length
if(length(unique(sapply(x, length))) != 1) stop("list x should contain elements with the same length.")
if(length(unique(sapply(y, length))) != 1) stop("list y should contain elements with the same length.")
if(length(unique(sapply(colour_by, length))) != 1 & !is.null(colour_by)) stop("list colour_by should contain elements with the same length.")
if(length(unique(sapply(labels, length))) != 1 & !is.null(labels)) stop("list labels should contain elements with the same length.")
if(!identical(length(x[[1]]), length(y[[1]]))) stop("All arguments should be of the the same length.")
if(!identical(length(x[[1]]), length(colour_by[[1]])) & !is.null(colour_by)) stop("All arguments should be of the the same length.")
if(!identical(length(x[[1]]), length(labels[[1]])) & !is.null(labels)) stop("All arguments should be of the the same length.")
if(!identical(ncol(expression), length(x[[1]])) & !is.null(expression)) stop("The number of columns in 'expression' should be equal to the length of the vector 'x'.")
if(!identical(length(x[[1]]), length(y[[1]]))) stop("all arguments should be of the the same length.")
if(!identical(length(x[[1]]), length(colour_by[[1]])) & !is.null(colour_by)) stop("all arguments should be of the the same length.")
if(!identical(length(x[[1]]), length(labels[[1]])) & !is.null(labels)) stop("all arguments should be of the the same length.")
# Add objects to env
# Create component environment
env <- new.env()
env$x <- x
env$x_selection <- length(env$x) > 1
......@@ -70,7 +54,13 @@ sequence_saturation <- function(object, x, y, colour_by = NULL, labels = NULL, t
env$labels <- labels
# save environment as rds-object
saveRDS(env, file = file.path(workdir, "envs", paste0(env_id, ".rds")))
print("validation TRUE")
env$expression <- expression
# 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", "scatterplot.Rmd", package = "i2dash.scrnaseq"), title = title, env_id = env_id, date = timestamp)
return(expanded_component)
}
#' Render a scatter plot
#' Renders a scatter plot
#'
#' @param labels A list with sample names, that should be of the same length as x and y.
#' @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 colour_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 df A dataframe containing the data for the boxplot
#' @param labels A list with sample names, which should be of the same length as x and y.
#' @param colour_by A list containing factorial values that will be used for colouring. In case of a named list, a dropdown menu will be provided in the interactive mode. Note: The length of all vectors in case of a named list should be of the same length as x and y.
#' @param checkbox A boolean value as indicator for colouring by labels.
#' @param selected_label The label (character) selected by the user.
#'
#' @return A list with 1. the plotly object & 2. the data frame used in the plot
#' @return An object of class \code{plotly}.
#' @export
.scatter_plot <- function(labels = NULL, x, y, colour_by = NULL, checkbox = FALSE, selected_label = NULL){
# create data.frame for plot (fill colour_by & labels with dummy data if NULL)
dummy_values <- FALSE
plot_list <- list()
if (!is.null(labels)) plot_list <- rlist::list.append(plot_list, labels) else plot_list <- rlist::list.append(plot_list, c(1:length(x[[1]])))
plot_list <- rlist::list.append(plot_list, c(x, y))
if (!is.null(colour_by)) {
plot_list <- rlist::list.append(plot_list, colour_by)
} else {
plot_list <- rlist::list.append(plot_list, c(1:length(x[[1]])))
dummy_values <- TRUE
}
plot_df <- do.call("data.frame", plot_list)
plotly_scatterplot <- function(df, labels = NULL, colour_by = NULL, expression = NULL, checkbox = FALSE, expr_checkbox = FALSE, selected_label = NULL){
# assign variables
labels <- plot_df[[1]]
x_value <- plot_df[[2]]
y_value <- plot_df[[3]]
colour_by <- plot_df[[4]]
x_title <- names(plot_df[2])
y_title <- names(plot_df[3])
if(is.null(checkbox)) checkbox <- FALSE
if(is.null(expr_checkbox)) expr_checkbox <- FALSE
if(dummy_values) {
colour_by <- NULL
}
# if(is.null(labels)) {
# labels <- NULL
# }
if(is.null(checkbox)) {
checkbox <- FALSE
}
# assign variables
if(!is.null(labels)) labels <- df[[1]]
x_value <- df[[2]]
y_value <- df[[3]]
if(!is.null(expression) & expr_checkbox) colour_by <- df[[4]]
if(!is.null(colour_by)) colour_by <- df[[4]]
x_title <- names(df[2])
y_title <- names(df[3])
# find point for annotation
a <- NULL
if (!is.null(labels)) {
if (checkbox) {
colour_by <- NULL
point_index <- match(selected_label, plot_df[[1]])
point <- plot_df[point_index,]
a <- list(
x = point[,2],
y = point[,3],
text = point[,1],
xref = "x",
yref = "y",
showarrow = T,
arrowhead = 7,
arrowcolor = "red",
ax = 20,
ay = -40
)
}
if (checkbox) {
colour_by <- NULL
point_index <- match(selected_label, df[[1]])
point <- df[point_index,]
a <- list(
x = point[,2],
y = point[,3],
text = point[,1],
xref = "x",
yref = "y",
showarrow = T,
arrowhead = 7,
arrowcolor = "red",
ax = 20,
ay = -40
)
}
# plotly
p <- plotly::plot_ly(plot_df,
x = x_value,
y = y_value,
color = colour_by,
text = labels
)
p <- plotly::add_markers(p)
p <- plotly::layout(p,
xaxis = list(title = x_title),
yaxis = list(title = y_title),
annotations = a)
return(p)
plotly::plot_ly(df, x = x_value, y = y_value, color = colour_by, text = labels) %>%
plotly::add_markers() %>%
plotly::layout(xaxis = list(title = x_title),
yaxis = list(title = y_title),
annotations = a)
}
#' Function to create a dataframe for plotly_barplot.
......
### {{ 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}
# Create data.frame
df <- data.frame(matrix(nrow = length({{ env_id }}$x[[1]]), ncol = 4, dimnames = list(c(1:length({{ env_id }}$x[[1]])), c("labels", names({{ env_id }}$x[1]), names({{ env_id }}$y[1]), "colour_by"))))
if (!is.null({{ env_id }}$labels)) {
df[1] <- {{ env_id }}$labels
}
df[2] <- {{ env_id }}$x[[1]]
df[3] <- {{ env_id }}$y[[1]]
if (!is.null({{ env_id }}$colour_by)) {
df[4] <- {{ env_id }}$colour_by[[1]]
colnames(df)[4] <- names({{ env_id }}$colour_by[1])
}
# Provide data for download
i2dash::embed_var(df)
# Render plot
i2dash.scrnaseq::plotly_scatterplot(df = df, labels = {{ env_id }}$labels, colour_by = {{ env_id }}$colour_by)
```
```{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)))
}
# Checkbox and selection field for colour by feature
if (!is.null({{ env_id }}$expression)) {
ui_list <- rlist::list.append(ui_list,
tags$div(checkboxInput("expr_checkbox_{{ env_id }}", label = "Colour by feature", value = FALSE),
selectInput("select_feature_{{ env_id }}", label = NULL, choices = rownames({{ env_id }}$expression))
))
}
# Checkbox and selection field for colour by sample name
if (!is.null({{ env_id }}$labels)) {
ui_list <- rlist::list.append(ui_list,
tags$div(checkboxInput("checkbox_{{ env_id }}", label = "Colour by sample name", value = FALSE),
selectInput("select_name_{{ env_id }}", label = NULL, choices = {{ env_id }}$labels)
))
}
# Download link
ui_list <- rlist::list.append(ui_list, tags$div(tags$br(), downloadButton('downloadData_{{ env_id }}', 'Download data')))
#
# Create reactive dataframe
#
df_{{ env_id }} <- shiny::reactive({
# Set values for 'labels'
if (!is.null({{ env_id }}$labels)) {
labels <- {{ env_id }}$labels
} else {
labels <- c(1:length({{ env_id }}$x[[1]]))
}
# Set values for 'x'
if( !{{ env_id }}$x_selection ) {
x <- {{ env_id }}$x[1]
} else {
x <- {{ env_id }}$x[input$select_x_{{ env_id }}]
}
# Set values for 'y'
if( !{{ env_id }}$y_selection ) {
y <- {{ env_id }}y[1]
} else {
y <- {{ env_id }}$y[input$select_y_{{ env_id }}]
}
# Set values for 'colour_by'
if (!{{ env_id }}$colour_by_selection){
colour_by <- {{ env_id }}$colour_by[1]
} else {
colour_by <- {{ env_id }}$colour_by[input$select_colour_{{ env_id }}]
}
# Create a data.frame
df <- data.frame(labels, x, y)
if(!is.null(input$expr_checkbox_{{ env_id }})){
if(input$expr_checkbox_{{ env_id }}){
df["colour_by"] <- {{ env_id }}$expression[input$select_feature_{{ env_id }},]
} else {
if(!is.null({{ env_id }}$colour_by)){
df["colour_by"] <- colour_by
} else {
df["colour_by"] <- c(1:length({{ env_id }}$x[[1]]))
}
}
} else{
if(!is.null({{ env_id }}$colour_by)){
df["colour_by"] <- colour_by
} else {
df["colour_by"] <- c(1:length({{ env_id }}$x[[1]]))
}
}
return(df)
})
#
# Download
#
output$downloadData_{{ env_id }} <- downloadHandler(
filename = paste('data-', Sys.Date(), '.csv', sep=''),
content = function(file) {
write.csv(df_{{ env_id }}(), file)
}
)
#
# Output
#
output$plot_{{ env_id }} <- plotly::renderPlotly(
i2dash.scrnaseq::plotly_scatterplot(df = df_{{ env_id }}(), labels = {{ env_id }}$labels, colour_by = {{ env_id }}$colour_by, checkbox = input$checkbox_{{ env_id }}, selected_label = input$select_name_{{ env_id }}, expression = {{ env_id }}$expression, expr_checkbox = input$expr_checkbox_{{ env_id }})
)
#
# Layout of component
#
shiny::fillCol(flex = c(NA, 1),
do.call(shiny::inputPanel, ui_list),
plotly::plotlyOutput("plot_{{ env_id }}", height = "100%")
)
```
### {{ 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])
# Create data.frame for download
df_list <- list()
if (!is.null({{ env_id }}$labels)) df_list <- rlist::list.append(df_list, {{ env_id }}$labels)
df_list <- rlist::list.append(df_list, c({{ env_id }}$x, {{ env_id }}$y))
if (!is.null({{ env_id }}$colour_by)) df_list <- rlist::list.append(df_list, {{ env_id }}$colour_by)
df <- do.call("data.frame", df_list)
# download_link
i2dash::embed_var(df)
# set variables
x <- {{ env_id }}$x[1]
y <- {{ env_id }}$y[1]
if (!is.null({{ env_id }}$colour_by)){
colour_by <- {{ env_id }}$colour_by[1]
} else {
colour_by <- NULL
}
################## Test scatter_plot funktion - funktioniert #######################
p <- i2dash.scrnaseq::.scatter_plot(labels = {{ env_id }}$labels, x = x, y = y, colour_by = colour_by)
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)))
}
# Checkbox and selection field for colour by sample name
if (!is.null({{ env_id }}$labels)) {
ui_list <- rlist::list.append(ui_list,
tags$div(checkboxInput("checkbox_{{ env_id }}", label = "Colour by sample name", value = FALSE),
selectInput("select_name_{{ env_id }}", label = NULL, choices = {{ env_id }}$labels)
))
}
# Create data.frame for download
df_list <- list()
if (!is.null({{ env_id }}$labels)) df_list <- rlist::list.append(df_list, {{ env_id }}$labels)
df_list <- rlist::list.append(df_list, c({{ env_id }}$x, {{ env_id }}$y))
if (!is.null({{ env_id }}$colour_by)) df_list <- rlist::list.append(df_list, {{ env_id }}$colour_by)
df <- do.call("data.frame", df_list)
# download_link
ui_list <- rlist::list.append(ui_list, i2dash::embed_var(df))
fillCol(flex = c(NA, 1),
do.call("inputPanel", ui_list),
plotly::plotlyOutput("plot_{{ env_id }}", height = "100%")
)
output$plot_{{ env_id }} <- plotly::renderPlotly({
# set variables
if (!{{ env_id }}$x_selection) x <- {{ env_id }}$x[1] else x <- {{ env_id }}$x[input$select_x_{{ env_id }}]
if (!{{ env_id }}$y_selection) y <- {{ env_id }}$y[1] else y <- {{ env_id }}$y[input$select_y_{{ env_id }}]
if (!{{ env_id }}$colour_by_selection){
if (!is.null({{ env_id }}$colour_by)){
colour_by <- {{ env_id }}$colour_by[1]
} else {
colour_by <- NULL
}
} else {
colour_by <- {{ env_id }}$colour_by[input$select_colour_{{ env_id }}]
}
################## Test scatter_plot funktion - funktioniert #######################
p <- i2dash.scrnaseq::.scatter_plot(labels = {{ env_id }}$labels, x = x, y = y, colour_by = colour_by, checkbox = input$checkbox_{{ env_id }}, selected_label = input$select_name_{{ env_id }})
p
})
###################### Funktionierende Variante ohne scatter_plot Funktion ############
#
# # create data.frame for plot
# plot_list <- list()
# if (!is.null({{ env_id }}$labels)) plot_list <- rlist::list.append(plot_list, {{ env_id }}$labels) else plot_list <- rlist::list.append(plot_list, c(1:length(x[[1]])))
# plot_list <- rlist::list.append(plot_list, c(x, y))
# if (!is.null({{ env_id }}$colour_by)) plot_list <- rlist::list.append(plot_list, colour_by) else plot_list <- rlist::list.append(plot_list, c(1:length(x[[1]])))
# plot_df <- do.call("data.frame", plot_list)
#
# labels <- plot_df[[1]]
# x_value <- plot_df[[2]]
# y_value <- plot_df[[3]]
# colour_by <- plot_df[[4]]
#
# x_title <- names(plot_df[[2]])
# y_title <- names(plot_df[[3]])
#
# if(is.null({{ env_id }}$labels)) {
# labels <- NULL
# }
# if(is.null({{ env_id }}$colour_by)) {
# colour_by <- NULL
# }
# #find point for annotation
# a <- NULL
# if (!is.null({{ env_id }}$labels)) {
# if (input$checkbox_{{ env_id }}) {
# colour_by <- NULL
# point_index <- match(input$select_name_{{ env_id }}, plot_df[[1]])
# point <- plot_df[point_index,]
# a <- list(
# x = point[,2],
# y = point[,3],
# text = point[,1],
# xref = "x",
# yref = "y",
# showarrow = T,
# arrowhead = 7,
# arrowcolor = "red",
# ax = 20,
# ay = -40
# )
# }
# }
#
# # plotly
# p <- plotly::plot_ly(plot_df,
# x = x_value,
# y = y_value,
# color = colour_by,
# text = labels
# )
# p <- plotly::add_markers(p)
# p <- plotly::layout(p,
# xaxis = list(title = x_title),
# yaxis = list(title = y_title),
# annotations = a)
# 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
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/visualization_functions.R
\name{.scatter_plot}
\alias{.scatter_plot}
\title{Render a scatter plot}
\usage{
.scatter_plot(labels = NULL, x, y, colour_by = NULL,
checkbox = FALSE, selected_label = NULL)
}
\arguments{
\item{labels}{A list with sample names, that should be of the same length as x and y.}
\item{x}{Numeric values mapped to the x-axis. In case of a nested list, a dropdown menu will be provided in the interactive mode.}
\item{y}{Numeric values mapped to the y-axis. In case of a nested list, a dropdown menu will be provided in the interactive mode.}
\item{colour_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.}
}
\value{
A list with 1. the plotly object & 2. the data frame used in the plot
}
\description{
Render a scatter plot
}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/visualization_functions.R
\name{plotly_scatterplot}
\alias{plotly_scatterplot}
\title{Renders a scatter plot}
\usage{
plotly_scatterplot(df, labels = NULL, colour_by = NULL,
expression = NULL, checkbox = FALSE, expr_checkbox = FALSE,
selected_label = NULL)
}
\arguments{