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

reexport added

changed scatterplot.rmd and scatterplot.r files. changed visualization_function;
bug exists
parent f6639ede
# Generated by roxygen2: do not edit by hand
export("%<>%")
export("%>%")
export(.bar_plot)
export(.scatter_plot)
export(boxplot)
export(plotly_boxplot)
export(plotly_scatterplot)
importFrom(magrittr,"%<>%")
importFrom(magrittr,"%>%")
#' magrittr forward-pipe operator
#'
#' See \code{\link[magrittr]{\%>\%}}.
#' @name %>%
#' @importFrom magrittr %>%
#' @export %>%
NULL
#' magrittr forward-backward-pipe operator
#'
#' See \code{\link[magrittr]{\%<>\%}}.
#' @name %<>%
#' @importFrom magrittr %<>%
#' @export %<>%
NULL
......@@ -4,51 +4,31 @@
#' @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 labels A list with sample names It should be of the same length as x and y. A dropdown menu for colouring by label will be provided.
#' @param title A title that will be displayed on top.
#'
#' @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, 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.")
# Check validity
# Validate input
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
# 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.")
......@@ -58,7 +38,8 @@ sequence_saturation <- function(object, x, y, colour_by = NULL, labels = NULL, t
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 +51,75 @@ 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")
# 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)
}
# # 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
# 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)
# 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.")
#
# # 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("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.")
#
# # 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
#
# env$labels <- labels
#
# # save environment as rds-object
# saveRDS(env, file = file.path(workdir, "envs", paste0(env_id, ".rds")))
# print("validation TRUE")
# }
#' 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.
......@@ -7,74 +7,86 @@
#'
#' @return A list with 1. the plotly object & 2. the data frame used in the plot
#' @export
.scatter_plot <- function(labels = NULL, x, y, colour_by = NULL, checkbox = FALSE, selected_label = NULL){
plotly_scatterplot <- function(df, labels = NULL, 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)
# 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)
# assign variables
labels <- plot_df[[1]]
x_value <- plot_df[[2]]
y_value <- plot_df[[3]]
colour_by <- plot_df[[4]]
if(!is.null(labels)) labels <- df[[1]]
x_value <- df[[2]]
y_value <- df[[3]]
if(!is.null(colour_by)) colour_by <- df[[4]]
x_title <- names(plot_df[2])
y_title <- names(plot_df[3])
x_title <- names(df[2])
y_title <- names(df[3])
if(dummy_values) {
colour_by <- NULL
}
# if(dummy_values) {
# colour_by <- NULL
# }
# if(is.null(labels)) {
# labels <- NULL
# }
if(is.null(checkbox)) {
checkbox <- FALSE
}
# if(is.null(checkbox)) {
# checkbox <- FALSE
# }
# 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
)
}
# 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
# )
# }
# }
# 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)
}
#' Render a bar plot
......
### {{ 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 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({{ 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 }})
)
#
# 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,