Commit 475fac8a authored by arsenij.ustjanzew's avatar arsenij.ustjanzew
Browse files

added plotly_barplot function to visualization_functions;

redone the barplot.R script;
redone the barplot.Rmd: one dataframe will be generated with a function in dependence of the if cases.
parent 0de9c508
# Generated by roxygen2: do not edit by hand
export(.bar_plot)
export("%<>%")
export("%>%")
export(.scatter_plot)
export(.violin_plot)
export(boxplot)
export(barplot)
export(plotly_barplot)
export(plotly_boxplot)
importFrom(magrittr,"%<>%")
importFrom(magrittr,"%>%")
#' Renders a barplot
#'
#' @param object A \linkS4class{i2dash::i2dashboard} object.
#' @param group_by A factor, by which observations are grouped. In case of a named list, a dropdown menu will be provided in the interactive mode.
#' @param x Numeric observations for the boxplot. In case of a named list, a dropdown menu will be provided in the interactive mode.
#' @param title The title of the components junk.
#'
#' @return A string containing markdown code for the rendered textbox
#' @export
barplot <- function(object, group_by, x = NULL, title = NULL, title_group_by = NULL, title_x = 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(group_by)) group_by <- list(group_by)
if(!is.list(x) & !is.null(x)) x <- list(x)
# name the lists
if(is.null(names(group_by))) x %<>% magrittr::set_names("sample")
if(is.null(names(x)) & !is.null(x)) x %<>% magrittr::set_names("values")
# Validate input
if(!all(sapply(group_by, is.factor))) stop("'group_by' should only contain factorial values.")
if(!all(sapply(x, is.factor)) & !is.null(x)) stop("'x' should only contain factorial values.")
# Create component environment
env <- new.env()
env$group_by_selection <- FALSE
env$x_selection <- FALSE
env$title_group_by <- title_group_by
env$title_x <- title_x
env$group_by <- group_by
env$group_by_selection <- length(env$group_by) > 1
env$x <- x
env$x_selection <- length(env$x) > 1
# 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", "barplot.Rmd", package = "i2dash.scrnaseq"), title = title, env_id = env_id, date = timestamp)
return(expanded_component)
}
#' 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
......@@ -77,53 +77,24 @@
return(p)
}
#' Render a bar plot
#' Render a bar plot with plotly.
#'
#' @param cluster Values for the membership to clusters. In case of a nested list, a dropdown menu will be provided in the interactive mode.
#' @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 x Numeric observations for the boxplot.
#' @param group_by A factor, by which observations can optionally be grouped.
#' @param title_x A title that describes the observations.
#' @param title_group_by A title that describes the grouping factor.
#' @param showlegend Boolean that describes if the legend is shown
#' @param names Names of the observationable categories
#'
#' @return A list with 1. the plotly object & 2. the data frame used in the plot
#' @return An object of class \code{plotly}.
#' @export
.bar_plot <- function(cluster, x = NULL){
#if x = NULL -> plot for "Number of cells"
#if x != NULL -> plot for "Number of fractions"
if(is.null(x)){
tab <- table(cluster)
tab_df <- as.data.frame(tab)
# plotly
title <- "Number of cells"
p <- plotly::plot_ly(tab_df, x = tab_df[[2]], y = tab_df[[1]],
name = names(tab_df[1]),
type = "bar", orientation = "h", opacity = 0.7)
p <- plotly::layout(p,
xaxis = list(title=title, showline = T),
yaxis = list(title="Cluster", showline = T, showticklabels = T),
showlegend = F
)
return(list("plot" = p, "df" = tab_df))
} else {
# create data.frame for plot
tab <- table(cluster[[1]],x[[1]])
ptab <- prop.table(tab,margin = 1)
ptab_df <- as.data.frame.matrix(ptab)
# plotly
title <- "Fraction of cells"
p <- plotly::plot_ly(ptab_df, type = "bar", orientation = "h", opacity = 0.7)
for(i in 1:length(names(ptab_df))){
p <- plotly::add_trace(p, x = ptab_df[[i]], y = row.names(ptab_df), name = names(ptab_df[i]))
}
p <- plotly::layout(p,
xaxis = list(title=title, showline = T),
yaxis = list(title="Cluster", showline = T, showticklabels = T),
barmode = 'stack',
showlegend = T
)
return(list("plot" = p, "df" = ptab_df))
}
plotly_barplot <- function(group_by, x = NULL, names = NULL, showlegend = NULL, title_x = NULL, title_group_by = NULL){
p <- plotly::plot_ly(type = "bar", orientation = "h", opacity = 0.7, x = x, y = group_by, name = names) %>%
plotly::layout(xaxis = list(title = title_x, showline = T),
yaxis = list(title = title_group_by, showline = T, showticklabels = T),
barmode = 'stack',
showlegend = showlegend)
p
}
#' Render a box plot with plotly.
......
### {{ 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
.create_barplot_df <- function(group_by, x = NULL){
if(is.null(x)){
tab <- table(group_by)
df <- as.data.frame(tab)
x <- df[[2]]
y <- df[[1]]
names <- NULL
showlegend <- F
return(list("df" = df, "x" = x, "y" = y, "names" = names, "showlegend" = showlegend))
} else {
tab <- table(group_by, x)
ptab <- prop.table(tab, margin = 1)
df <- as.data.frame(ptab)
x <- df[[3]]
y <- df[[1]]
names <- df[[2]]
showlegend <- T
return(list("df" = df, "x" = x, "y" = y, "names" = names, "showlegend" = showlegend))
}
}
output_list <- .create_barplot_df(group_by = {{ env_id }}$group_by[[1]], x = {{ env_id }}$x[[1]])
i2dash::embed_var(output_list$df)
# Render plot
i2dash.scrnaseq::plotly_barplot(x = output_list$x, group_by = output_list$y, names = output_list$names, showlegend = output_list$showlegend, title_x = {{ env_id }}$title_x, title_group_by = {{ env_id }}$title_group_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 observations:",
choices = names({{ env_id }}$x)))
}
# 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')))
# Function to create a dataframe for bar plot
.create_barplot_df <- function(group_by, x = NULL){
if(is.null(x)){
tab <- table(group_by)
df <- as.data.frame(tab)
x <- df[[2]]
y <- df[[1]]
names <- NULL
showlegend <- F
return(list("df" = df, "x" = x, "y" = y, "names" = names, "showlegend" = showlegend))
} else {
tab <- table(group_by, x)
ptab <- prop.table(tab, margin = 1)
df <- as.data.frame(ptab)
x <- df[[3]]
y <- df[[1]]
names <- df[[2]]
showlegend <- T
return(list("df" = df, "x" = x, "y" = y, "names" = names, "showlegend" = showlegend))
}
}
#
# Create reactive dataframe
#
df_{{ env_id }} <- shiny::reactive({
if({{ env_id }}$group_by_selection & {{ env_id }}$x_selection){
.create_barplot_df(group_by = {{ env_id }}$group_by[[input$select_group_by_{{ env_id }}]], x = {{ env_id }}$x[[input$select_x_{{ env_id }}]])
} else if (!{{ env_id }}$group_by_selection & {{ env_id }}$x_selection){
.create_barplot_df(group_by = {{ env_id }}$group_by[[1]], x = {{ env_id }}$x[[input$select_x_{{ env_id }}]])
} else if ({{ env_id }}$group_by_selection & !{{ env_id }}$x_selection){
.create_barplot_df(group_by = {{ env_id }}$group_by[[input$select_group_by_{{ env_id }}]], x = {{ env_id }}$x[[1]])
} else if (!{{ env_id }}$group_by_selection & !{{ env_id }}$x_selection){
.create_barplot_df(group_by = {{ env_id }}$group_by[[1]], x = {{ env_id }}$x[[1]])
}
})
#
# 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_barplot(x = df_{{ env_id }}()$x, group_by = df_{{ env_id }}()$y, names = df_{{ env_id }}()$names, showlegend = df_{{ env_id }}()$showlegend, title_x = {{ env_id }}$title_x, title_group_by = {{ env_id }}$title_group_by)
})
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/barplot.R
\name{barplot}
\alias{barplot}
\title{Renders a barplot}
\usage{
barplot(object, group_by, x = NULL, title = NULL,
title_group_by = NULL, title_x = NULL)
}
\arguments{
\item{object}{A \linkS4class{i2dash::i2dashboard} object.}
\item{group_by}{A factor, by which observations are grouped. In case of a named list, a dropdown menu will be provided in the interactive mode.}
\item{x}{Numeric observations for the boxplot. In case of a named list, a dropdown menu will be provided in the interactive mode.}
\item{title}{The title of the components junk.}
}
\value{
A string containing markdown code for the rendered textbox
}
\description{
Renders a barplot
}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/visualization_functions.R
\name{.bar_plot}
\alias{.bar_plot}
\title{Render a bar plot}
\usage{
.bar_plot(cluster, x = NULL)
}
\arguments{
\item{cluster}{Values for the membership to clusters. In case of a nested list, a dropdown menu will be provided in the interactive mode.}
\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.}
}
\value{
A list with 1. the plotly object & 2. the data frame used in the plot
}
\description{
Render a bar plot
}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/reexports.R
\name{\%>\%}
\alias{\%>\%}
\title{magrittr forward-pipe operator}
\description{
See \code{\link[magrittr]{\%>\%}}.
}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/reexports.R
\name{\%<>\%}
\alias{\%<>\%}
\title{magrittr forward-backward-pipe operator}
\description{
See \code{\link[magrittr]{\%<>\%}}.
}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/visualization_functions.R
\name{plotly_barplot}
\alias{plotly_barplot}
\title{Render a bar plot with plotly.}
\usage{
plotly_barplot(group_by, x = NULL, names = NULL, showlegend = NULL,
title_x = NULL, title_group_by = NULL)
}
\arguments{
\item{group_by}{A factor, by which observations can optionally be grouped.}
\item{x}{Numeric observations for the boxplot.}
\item{names}{Names of the observationable categories}
\item{showlegend}{Boolean that describes if the legend is shown}
\item{title_x}{A title that describes the observations.}
\item{title_group_by}{A title that describes the grouping factor.}
}
\value{
An object of class \code{plotly}.
}
\description{
Render a bar plot with plotly.
}
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