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.

NAMESPACE

 # 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,"%>%")

R/barplot.R

+#' 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)
+}

R/reexports.R

+#' 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

R/visualization_functions.R

@@ -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.

inst/templates/barplot.Rmd

+
+### {{ 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%")
+)
+```
+

man/barplot.Rd

+% 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
+}

man/dot-bar_plot.Rd

-% 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
-}

man/grapes-greater-than-grapes.Rd

+% 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]{\%>\%}}.
+}

man/grapes-less-than-greater-than-grapes.Rd

+% 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]{\%<>\%}}.
+}

man/plotly_barplot.Rd

+% 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.
+}