Skip to content
GitLab
Commit 94a0f97c authored by arsenij.ustjanzew's avatar arsenij.ustjanzew
Browse files

extended functionality with coloring by feature

parent 86e4defc
Hide whitespace changes
Inline Side-by-side
R/scatterplot.R
View file @ 94a0f97c
......@@ -5,10 +5,11 @@
#' @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
scatterplot <- function(object, x, y, colour_by = NULL, labels = NULL, title = NULL) {
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]"))
......@@ -25,18 +26,20 @@ scatterplot <- function(object, x, y, colour_by = NULL, labels = NULL, title = N
if(is.null(names(labels)) & !is.null(labels)) labels %<>% magrittr::set_names("labels")
# 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(!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, 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.")
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.")
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'.")
# Create component environment
env <- new.env()
......@@ -51,6 +54,8 @@ scatterplot <- function(object, x, y, colour_by = NULL, labels = NULL, title = N
env$labels <- labels
env$expression <- expression
# Save environment object
saveRDS(env, file = file.path(object@workdir, "envs", paste0(env_id, ".rds")))
......
R/visualization_functions.R
View file @ 94a0f97c
......@@ -8,20 +8,20 @@
#'
#' @return An object of class \code{plotly}.
#' @export
plotly_scatterplot <- function(df, labels = NULL, colour_by = NULL, checkbox = FALSE, selected_label = NULL){
plotly_scatterplot <- function(df, labels = NULL, colour_by = NULL, expression = NULL, checkbox = FALSE, expr_checkbox = FALSE, selected_label = NULL){
if(is.null(checkbox)) checkbox <- FALSE
if(is.null(expr_checkbox)) expr_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])
if(is.null(checkbox)) {
checkbox <- FALSE
}
# find point for annotation
a <- NULL
if (checkbox) {
......
inst/templates/scatterplot.Rmd
View file @ 94a0f97c
......@@ -32,7 +32,6 @@ i2dash.scrnaseq::plotly_scatterplot(df = df, labels = {{ env_id }}$labels, colou
```{r, eval=is_shiny}
ui_list <- list()
# selection field for x
if ({{ env_id }}$x_selection){
ui_list <- rlist::list.append(ui_list,
......@@ -54,6 +53,14 @@ if ({{ env_id }}$colour_by_selection){
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,
......@@ -97,12 +104,23 @@ df_{{ env_id }} <- shiny::reactive({
# 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]]))
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)
})
......@@ -120,7 +138,7 @@ output$downloadData_{{ env_id }} <- downloadHandler(
# 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 }})
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 }})
)
#
......
man/plotly_scatterplot.Rd
View file @ 94a0f97c
......@@ -5,7 +5,8 @@
\title{Renders a scatter plot}
\usage{
plotly_scatterplot(df, labels = NULL, colour_by = NULL,
checkbox = FALSE, selected_label = NULL)
expression = NULL, checkbox = FALSE, expr_checkbox = FALSE,
selected_label = NULL)
}
\arguments{
\item{df}{A dataframe containing the data for the boxplot}
......
man/scatterplot.Rd
View file @ 94a0f97c
......@@ -5,7 +5,7 @@
\title{Renders a scatter plot}
\usage{
scatterplot(object, x, y, colour_by = NULL, labels = NULL,
title = NULL)
expression = NULL, title = NULL)
}
\arguments{
\item{object}{A \linkS4class{i2dash::i2dashboard} object.}
......@@ -18,6 +18,8 @@ scatterplot(object, x, y, colour_by = NULL, labels = NULL,
\item{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.}
\item{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.}
\item{title}{(Optional) The title of the components junk.}
}
\value{
......
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