Skip to content
Snippets Groups Projects
Commit 2a9ac5ec authored by jens.preussner's avatar jens.preussner :ghost:
Browse files

Clean up; Moved to different packge

parent 4b26bda3
Branches
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
Showing
with 0 additions and 400 deletions
R/features_by_factors.R deleted 100644 → 0
+ 0
− 61
View file @ 4b26bda3
#' Renders a features by factor violin plot
#'
#' @param plot_title The title of the Component
#' @param x A list with the x-axis values. If it is a nested list, a dropdown-field will be provided in the interactive mode.
#' @param y A list with the y-axis values. If it is a nested list, a dropdown-field will be provided in the interactive mode.(Needs to be categorial. Horizontal violinplots are not possible.)
#'
#' @return A string containing markdown code for the rendered textbox
render_features_by_factors <- function(object, plot_title, x, y) {
env_id <- .create_id()
# validate input, create environment variables, save environment object
.validate_input_ff(object, env_id, x, y)
timestamp <- Sys.time()
expanded_component <- knitr::knit_expand(file = system.file("templates", "features_by_factors_template.Rmd", package = "i2dash"), plot_title = plot_title, env_id = env_id, date = timestamp)
return(expanded_component)
}
.create_id <- function(n = 1) {
a <- do.call(paste0, replicate(5, sample(LETTERS, n, TRUE), FALSE))
paste0(a, sprintf("%04d", sample(9999, n, TRUE)), sample(LETTERS, n, TRUE))
}
.validate_input_ff <- function(object, env_id, x, y) {
env <- new.env()
env$x_selection <- FALSE
env$y_selection <- FALSE
# validate x and create environment variables
if(is.list(x) & length(x) == 1) {
if (is.factor(x[[1]])){
env$x <- x
} else {
stop("x should contain factors")
}
} else if (is.list(x) & length(x) > 1) {
for (i in length(x)){
if (is.factor(x[[i]])){
env$x_selection <- TRUE
env$x <- x
} else {
stop("x should contain only factors")
}
}
} else if (!is.list(x) | (is.list(x) & length(x) == 0)){
stop("x needs to be a named list with at least one element")
}
# validate y and create environment variables
if(is.list(y) & length(y) == 1) {
env$y <- y
} else if (is.list(y) & length(y) > 1) {
env$y_selection <- TRUE
env$y <- y
} else if (!is.list(y) | (is.list(y) & length(y) == 0)){
stop("y needs to be a named list with at least one element")
}
# save environment as rds-object
saveRDS(env, file = file.path(object@workdir, "envs", sprintf("%s.rds", env_id)))
}
\ No newline at end of file
R/multiplot.R deleted 100644 → 0
+ 0
− 67
View file @ 4b26bda3
#' Renders a Sequence saturation plot
#'
#' @param plot_title The title of the Component
#' @param x A list with the x-axis values. If it is a nested list, a dropdown-field will be provided in the interactive mode.
#' @param y A list with the y-axis values. If it is a nested list, a dropdown-field will be provided in the interactive mode.
#' @param color_by A list with the color_by values. If it is a nested list, a dropdown-field will be provided in the interactive mode.
#'
#' @return A string containing markdown code for the rendered textbox
render_multiplot <- function(object, plot_title, x, y, color_by) {
env_id <- .create_id()
# validate input, create environment variables, save environment object
.validate_input(object, env_id, x, y, color_by)
timestamp <- Sys.time()
expanded_component <- knitr::knit_expand(file = system.file("templates", "multiplot_template.Rmd", package = "i2dash"), plot_title = plot_title, env_id = env_id, date = timestamp)
return(expanded_component)
}
.create_id <- function(n = 1) {
a <- do.call(paste0, replicate(5, sample(LETTERS, n, TRUE), FALSE))
paste0(a, sprintf("%04d", sample(9999, n, TRUE)), sample(LETTERS, n, TRUE))
}
.validate_input <- function(object, env_id, x, y, color_by) {
env <- new.env()
env$x_selection <- FALSE
env$y_selection <- FALSE
env$color_selection <- FALSE
# validate x and create environment variables
if(is.list(x) & length(x) == 1) {
env$x <- x
} else if (is.list(x) & length(x) > 1) {
env$x_selection <- TRUE
env$x <- x
} else if (!is.list(x) | (is.list(x) & length(x) == 0)){
stop("x needs to be a named list with at least one element")
}
# validate y and create environment variables
if(is.list(y) & length(y) == 1) {
env$y <- y
} else if (is.list(y) & length(y) > 1) {
env$y_selection <- TRUE
env$y <- y
} else if (!is.list(y) | (is.list(y) & length(y) == 0)){
stop("y needs to be a named list with at least one element")
}
# validate color_by and create environment variables
if(is.list(color_by) & length(color_by) == 1) {
env$color_by <- color_by
} else if (is.list(color_by) & length(color_by) > 1) {
env$color_selection <- TRUE
env$color_by <- color_by
} else if (!is.list(color_by) | (is.list(color_by) & length(color_by) == 0)){
stop("color_by needs to be a named list with at least one element")
}
# for (i in color_by){
# if (!is.factor(i)){
# stop("color_by needs to be a list with factorial elements")
# }
# }
# save environment as rds-object
saveRDS(env, file = file.path(object@workdir, "envs", sprintf("%s.rds", env_id)))
}
\ No newline at end of file
R/sequence_saturation.R deleted 100644 → 0
+ 0
− 67
View file @ 4b26bda3
#' Renders a Sequence saturation plot
#'
#' @param plot_title The title of the Component
#' @param x A list with the x-axis values. If it is a nested list, a dropdown-field will be provided in the interactive mode.
#' @param y A list with the y-axis values. If it is a nested list, a dropdown-field will be provided in the interactive mode.
#' @param color_by A list with the color_by values. If it is a nested list, a dropdown-field will be provided in the interactive mode.
#'
#' @return A string containing markdown code for the rendered textbox
render_sequence_saturation <- function(object, plot_title, x, y, color_by) {
env_id <- .create_id()
# validate input, create environment variables, save environment object
.validate_input(object, env_id, x, y, color_by)
timestamp <- Sys.time()
expanded_component <- knitr::knit_expand(file = system.file("templates", "sequence_saturation_template.Rmd", package = "i2dash"), plot_title = plot_title, env_id = env_id, date = timestamp)
return(expanded_component)
}
.create_id <- function(n = 1) {
a <- do.call(paste0, replicate(5, sample(LETTERS, n, TRUE), FALSE))
paste0(a, sprintf("%04d", sample(9999, n, TRUE)), sample(LETTERS, n, TRUE))
}
.validate_input <- function(object, env_id, x, y, color_by) {
env <- new.env()
env$x_selection <- FALSE
env$y_selection <- FALSE
env$color_selection <- FALSE
# validate x and create environment variables
if(is.list(x) & length(x) == 1) {
env$x <- x
} else if (is.list(x) & length(x) > 1) {
env$x_selection <- TRUE
env$x <- x
} else if (!is.list(x) | (is.list(x) & length(x) == 0)){
stop("x needs to be a named list with at least one element")
}
# validate y and create environment variables
if(is.list(y) & length(y) == 1) {
env$y <- y
} else if (is.list(y) & length(y) > 1) {
env$y_selection <- TRUE
env$y <- y
} else if (!is.list(y) | (is.list(y) & length(y) == 0)){
stop("y needs to be a named list with at least one element")
}
# validate color_by and create environment variables
if(is.list(color_by) & length(color_by) == 1) {
env$color_by <- color_by
} else if (is.list(color_by) & length(color_by) > 1) {
env$color_selection <- TRUE
env$color_by <- color_by
} else if (!is.list(color_by) | (is.list(color_by) & length(color_by) == 0)){
stop("color_by needs to be a named list with at least one element")
}
# for (i in color_by){
# if (!is.factor(i)){
# stop("color_by needs to be a list with factorial elements")
# }
# }
# save environment as rds-object
saveRDS(env, file = file.path(object@workdir, "envs", sprintf("%s.rds", env_id)))
}
\ No newline at end of file
inst/templates/features_by_factors_template.Rmd deleted 100644 → 0
+ 0
− 67
View file @ 4b26bda3
### {{plot_title}}
<!-- Page created on {{ date }} -->
```{r}
{{ env_id }} = readRDS("envs/{{ env_id }}.rds")
plotly::plotlyOutput("plot_{{ env_id }}")
output$plot_{{ env_id }} <- plotly::renderPlotly({
if (!{{ env_id }}$x_selection){
x_value <- {{ env_id }}$x[[1]]
x_title <- names({{ env_id }}$x)
} else {
x_value <- {{ env_id }}$x[[input$select_x_{{ env_id }}]]
x_title <- input$select_x_{{ env_id }}
}
if (!{{ env_id }}$y_selection){
y_value <- {{ env_id }}$y[[1]]
y_title <- names({{ env_id }}$y)
} else {
y_value <- {{ env_id }}$y[[input$select_y_{{ env_id }}]]
y_title <- input$select_y_{{ env_id }}
}
p <- plotly::plot_ly(data.frame(x_value, y_value),
x = x_value,
y = y_value,
split = x_value,
type = 'violin',
box = list(
visible = T
),
meanline = list(
visible = T
)
)
p <- plotly::layout(p,
xaxis = list(title = x_title),
yaxis = list(title = y_title,
zeroline = F))
p
})
```
***
```{r}
# selection field for x
if ({{ env_id }}$x_selection){
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){
selectInput("select_y_{{ env_id }}", label = "Select data for y axis:",
choices = names({{ env_id }}$y))
}
```
Plot description:
Sequencing is called *saturated* when generating more sequencing output from a cDNA library does not substantially increase the number of detected features in a sample. Since the number of detected features can act as a technical confounder, and thereby drive substructure in the data, it is advisable to aim for a saturated sequencing by either adding more sequencing output or decreasing the number of samples until saturation is achieved. [@zhang_one_2018] gives advise on how to choose the optimal cell number given a fixed sequencing budget
inst/templates/multiplot_template.Rmd deleted 100644 → 0
+ 0
− 58
View file @ 4b26bda3
### {{plot_title}}
<!-- Component created on {{ date }} -->
```{r}
{{ env_id }} = readRDS("envs/{{ env_id }}.rds")
df <- data.frame({{ env_id }}$x, {{ env_id }}$y, {{ env_id }}$color_by)
df.melted <- reshape::melt(df, id=c(names({{ env_id }}$y), names({{ env_id }}$color_by)))
plotly::plotlyOutput("plot_{{ env_id }}")
output$plot_{{ env_id }} <- plotly::renderPlotly({
if (!{{ env_id }}$y_selection){
index_y <- match(names({{ env_id }}$y), names(df.melted))
} else {
index_y <- match(input$select_y_{{ env_id }}, names(df.melted))
}
if (!{{ env_id }}$color_selection){
index_color <- match(names({{ env_id }}$color_by), names(df.melted))
} else {
index_color <- match(input$select_color_{{ env_id }}, names(df.melted))
}
g1 <- ggplot2::ggplot(df.melted, mapping = ggplot2::aes(y = value, x = df.melted[,index_y], color = df.melted[,index_color])) +
ggplot2::geom_jitter() +
ggplot2::geom_violin(mapping = ggplot2::aes(y = value), scale = "count") +
ggplot2::facet_grid(. ~ variable, scales = "free_x") +
ggplot2::theme_bw() +
ggplot2::theme(panel.border = ggplot2::element_blank()) +
ggplot2::scale_colour_viridis_c() +
ggplot2::coord_flip() +
ggplot2::labs( y="Type", x="", color=names(df.melted)[index_color])
plotly::ggplotly(g1)
})
```
***
```{r}
# selection field for y
if ({{ env_id }}$y_selection){
selectInput("select_y_{{ env_id }}", label = "Select data for y axis:",
choices = names({{ env_id }}$y))
}
# selection field for color_by
if ({{ env_id }}$color_selection){
selectInput("select_color_{{ env_id }}", label = "Select experimental factor for coloring:",
choices = names({{ env_id }}$color_by))
}
```
Plot description:
Sequencing is called *saturated* when generating more sequencing output from a cDNA library does not substantially increase the number of detected features in a sample. Since the number of detected features can act as a technical confounder, and thereby drive substructure in the data, it is advisable to aim for a saturated sequencing by either adding more sequencing output or decreasing the number of samples until saturation is achieved. [@zhang_one_2018] gives advise on how to choose the optimal cell number given a fixed sequencing budget
inst/templates/page_template.Rmd deleted 100644 → 0
+ 0
− 6
View file @ 4b26bda3
{{ title }} {{ layout_with_menu }}
=========================================
<!-- Page created on {{ date }} -->
{{ components }}
\ No newline at end of file
inst/templates/sequence_saturation_template.Rmd deleted 100644 → 0
+ 0
− 70
View file @ 4b26bda3
### {{plot_title}}
<!-- Component created on {{ date }} -->
```{r}
{{ env_id }} = readRDS("envs/{{ env_id }}.rds")
plotly::plotlyOutput("plot_{{ env_id }}")
output$plot_{{ env_id }} <- plotly::renderPlotly({
if (!{{ env_id }}$x_selection){
x_value <- {{ env_id }}$x[[1]]
x_title <- names({{ env_id }}$x)
} else {
x_value <- {{ env_id }}$x[[input$select_x_{{ env_id }}]]
x_title <- input$select_x_{{ env_id }}
}
if (!{{ env_id }}$y_selection){
y_value <- {{ env_id }}$y[[1]]
y_title <- names({{ env_id }}$y)
} else {
y_value <- {{ env_id }}$y[[input$select_y_{{ env_id }}]]
y_title <- input$select_y_{{ env_id }}
}
if (!{{ env_id }}$color_selection){
color_value <- {{ env_id }}$color_by[[1]]
} else {
color_value <- {{ env_id }}$color_by[[input$select_color_{{ env_id }}]]
}
p <- plotly::plot_ly(data.frame(x_value, y_value, color_value),
x = x_value,
y = y_value,
color = color_value
)
p <- plotly::layout(p,
xaxis = list(title = x_title),
yaxis = list(title = y_title))
p
})
```
***
```{r}
# selection field for x
if ({{ env_id }}$x_selection){
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){
selectInput("select_y_{{ env_id }}", label = "Select data for y axis:",
choices = names({{ env_id }}$y))
}
# selection field for color_by
if ({{ env_id }}$color_selection){
selectInput("select_color_{{ env_id }}", label = "Select experimental factor for coloring:",
choices = names({{ env_id }}$color_by))
}
```
Plot description:
Sequencing is called *saturated* when generating more sequencing output from a cDNA library does not substantially increase the number of detected features in a sample. Since the number of detected features can act as a technical confounder, and thereby drive substructure in the data, it is advisable to aim for a saturated sequencing by either adding more sequencing output or decreasing the number of samples until saturation is achieved. [@zhang_one_2018] gives advise on how to choose the optimal cell number given a fixed sequencing budget
inst/templates/textbox.Rmd deleted 100644 → 0
+ 0
− 4
View file @ 4b26bda3
### {{ page_title }}
{{ content }} {.storyboard}
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment