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

boxplot.R:

added title arguments of x and group_by;
small changes in validation steps and description;
naming the lists;

boxplot.Rmd:
adapted the part for statical report;
added download option;
combined reactives to one single reactive outputting a data frame

visualization_function:
adapted the plotly_boxplot function for dataframe as input
parent 0de9c508
...@@ -16,4 +16,5 @@ Imports: ...@@ -16,4 +16,5 @@ Imports:
stringi, stringi,
plotly, plotly,
shiny, shiny,
knitr knitr,
magrittr
# Generated by roxygen2: do not edit by hand # Generated by roxygen2: do not edit by hand
export(.bar_plot) export("%<>%")
export("%>%")
export(.scatter_plot) export(.scatter_plot)
export(.violin_plot)
export(boxplot) export(boxplot)
export(plotly_boxplot) export(plotly_boxplot)
importFrom(magrittr,"%<>%")
importFrom(magrittr,"%>%")
#' Renders a boxplot for cluster characterization #' Renders a boxplot
#' #'
#' @param object A \linkS4class{i2dash::i2dashboard} object. #' @param object A \linkS4class{i2dash::i2dashboard} object.
#' @param x Numeric observations for the boxplot. 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.
...@@ -6,21 +6,26 @@ ...@@ -6,21 +6,26 @@
#' @param title The title of the components junk. #' @param title The title of the components junk.
#' #'
#' @return A string containing markdown code for the rendered component. #' @return A string containing markdown code for the rendered component.
#'
#' @export #' @export
boxplot <- function(object, x, group_by, title = NULL) { boxplot <- function(object, x, group_by = NULL, title = NULL, title_x = NULL, title_group_by = NULL) {
# Create random env id # Create random env id
env_id <- paste0("env_", stringi::stri_rand_strings(1, 6, pattern = "[A-Za-z0-9]")) 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(x)) x <- list(x) if(!is.list(x)) x <- list(x)
if(!is.list(group_by)) group_by <- list(group_by) if(!is.list(group_by) & !is.null(group_by)) group_by <- list(group_by)
# name the lists
if(is.null(names(group_by)) & !is.null(group_by)) group_by %<>% magrittr::set_names("group")
if(is.null(names(x))) x %<>% magrittr::set_names("sample")
# Validate input # Validate input
if(!all(sapply(x, is.numeric))) stop("'x' should only contain numerical values.") if(!all(sapply(x, is.numeric))) stop("'x' should only contain numerical values.")
if(!all(sapply(cluster, is.factor))) stop("'cluster' should only contain factorial values.") if(!all(sapply(group_by, is.factor)) & !is.null(group_by)) stop("'group_by' should only contain factorial values.")
# Create component environment # Create component environment
env <- new.env() env <- new.env()
env$x_selection <- FALSE env$x_selection <- FALSE
env$group_by_selection <- FALSE env$group_by_selection <- FALSE
...@@ -30,6 +35,9 @@ boxplot <- function(object, x, group_by, title = NULL) { ...@@ -30,6 +35,9 @@ boxplot <- function(object, x, group_by, title = NULL) {
env$group_by <- group_by env$group_by <- group_by
env$group_by_selection <- length(env$group_by) > 1 env$group_by_selection <- length(env$group_by) > 1
env$title_x <- title_x
env$title_group_by <- title_group_by
# save environment object # save environment object
saveRDS(env, file = file.path(object@workdir, "envs", paste0(env_id, ".rds"))) saveRDS(env, file = file.path(object@workdir, "envs", paste0(env_id, ".rds")))
......
#' 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
...@@ -11,15 +11,19 @@ is_shiny <- identical(knitr::opts_knit$get("rmarkdown.runtime"), "shiny") ...@@ -11,15 +11,19 @@ is_shiny <- identical(knitr::opts_knit$get("rmarkdown.runtime"), "shiny")
```{r, eval=!is_shiny} ```{r, eval=!is_shiny}
# set variables # set variables
x <- {{ env_id }}$x[[1]] x <- {{ env_id }}$x[1]
group_by <- {{ env_id }}$group_by[[1]] group_by <- {{ env_id }}$group_by[1]
if(is.null(group_by)){
df <- data.frame(x)
} else {
df <- data.frame(x, group_by)
}
# Provide data download # Provide data download
# data.frame(x, group_by) %>% i2dash::embed_var(df)
# i2dash::embed_var()
# Render plot # Render plot
i2dash.scrnaseq::plotly_box_plot(x = x, group_by = group_by) i2dash.scrnaseq::plotly_boxplot(df = df, group_by = {{ env_id }}$group_by, title_x = {{ env_id }}$title_x, title_group_by = {{ env_id }}$title_group_by)
``` ```
```{r, eval=is_shiny} ```{r, eval=is_shiny}
...@@ -39,34 +43,49 @@ if ({{ env_id }}$group_by_selection) { ...@@ -39,34 +43,49 @@ if ({{ env_id }}$group_by_selection) {
choices = names({{ env_id }}$group_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')))
# #
# Handle inputs # Create reactive dataframe
# #
if( !{{ env_id }}$x_selection ) { df_{{ env_id }} <- shiny::reactive({
x_{{ env_id }} <- shiny::reactive({
{{ env_id }}$x[[1]] if( !{{ env_id }}$x_selection ) {
}) x <- {{ env_id }}$x[1]
} else { } else {
x_{{ env_id }} <- shiny::reactive({ x <- {{ env_id }}$x[input$select_x_{{ env_id }}]
{{ env_id }}$x[[input$select_x_{{ env_id }}]] }
})
}
if( !{{ env_id }}$group_by_selection ) { if( !{{ env_id }}$group_by_selection ) {
group_by_{{ env_id }} <- shiny::reactive({ group_by <- {{ env_id }}$group_by[1]
{{ env_id }}$group_by[[1]] } else {
}) group_by <- {{ env_id }}$group_by[input$select_group_by_{{ env_id }}]
} else { }
group_by_{{ env_id }} <- shiny::reactive({
{{ env_id }}$group_by[[input$select_group_by_{{ env_id }}]] if(is.null(group_by)){
df <- data.frame(x)
} else {
df <- data.frame(x, group_by)
}
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
# #
output$plot_{{ env_id }} <- plotly::renderPlotly( output$plot_{{ env_id }} <- plotly::renderPlotly(
i2dash.scrnaseq::plotly_box_plot(x = x_{{ env_id }}(), group_by = group_by_{{ env_id }}()) i2dash.scrnaseq::plotly_boxplot(df = df_{{ env_id }}(), group_by = {{ env_id }}$group_by, title_x = {{ env_id }}$title_x, title_group_by = {{ env_id }}$title_group_by)
) )
shiny::fillCol(flex = c(NA, 1), shiny::fillCol(flex = c(NA, 1),
...@@ -74,3 +93,4 @@ shiny::fillCol(flex = c(NA, 1), ...@@ -74,3 +93,4 @@ shiny::fillCol(flex = c(NA, 1),
plotly::plotlyOutput("plot_{{ env_id }}", height = "100%") plotly::plotlyOutput("plot_{{ env_id }}", height = "100%")
) )
``` ```
...@@ -2,9 +2,10 @@ ...@@ -2,9 +2,10 @@
% Please edit documentation in R/boxplot.R % Please edit documentation in R/boxplot.R
\name{boxplot} \name{boxplot}
\alias{boxplot} \alias{boxplot}
\title{Renders a boxplot for cluster characterization} \title{Renders a boxplot}
\usage{ \usage{
boxplot(object, x, group_by, title = NULL) boxplot(object, x, group_by = NULL, title = NULL, title_x = NULL,
title_group_by = NULL)
} }
\arguments{ \arguments{
\item{object}{A \linkS4class{i2dash::i2dashboard} object.} \item{object}{A \linkS4class{i2dash::i2dashboard} object.}
...@@ -19,5 +20,5 @@ boxplot(object, x, group_by, title = NULL) ...@@ -19,5 +20,5 @@ boxplot(object, x, group_by, title = NULL)
A string containing markdown code for the rendered component. A string containing markdown code for the rendered component.
} }
\description{ \description{
Renders a boxplot for cluster characterization Renders a boxplot
} }
% 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]{\%<>\%}}.
}
...@@ -4,13 +4,14 @@ ...@@ -4,13 +4,14 @@
\alias{plotly_boxplot} \alias{plotly_boxplot}
\title{Render a box plot with plotly.} \title{Render a box plot with plotly.}
\usage{ \usage{
plotly_boxplot(x, group_by = NULL, title = "", group_by_title = NULL) plotly_boxplot(df, group_by = NULL, title_x = NULL,
title_group_by = NULL)
} }
\arguments{ \arguments{
\item{x}{Numeric observations for the boxplot.}
\item{group_by}{A factor, by which observations can optionally be grouped.} \item{group_by}{A factor, by which observations can optionally be grouped.}
\item{x}{Numeric observations for the boxplot.}
\item{title}{A title that describes the observations.} \item{title}{A title that describes the observations.}
\item{group_by_title}{A title that describes the grouping factor.} \item{group_by_title}{A title that describes the grouping factor.}
......
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