Skip to content
This repository has been archived by the owner. It is now read-only.

Commit

Permalink
Merge branch 'master' into debug
Browse files Browse the repository at this point in the history 
# Conflicts:
#	R/geneView.R
#	R/global_cor_heatmap.R
#	R/heatmap.R
#	R/pca.R
#	R/scatterPlot.R
  • Loading branch information
@HendrikSchultheis
HendrikSchultheis committed Jan 24, 2018
2 parents 79c8a8d + d81617d commit 6d62324
Show file tree
Hide file tree
Showing 21 changed files with 294 additions and 145 deletions.
118 changes: 74 additions & 44 deletions R/function.R
View file

Large diffs are not rendered by default.

57 changes: 38 additions & 19 deletions R/geneView.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -98,6 +98,7 @@ geneViewUI <- function(id, plot.columns = 3){
#' @param width Width of the plot in cm. Defaults to minimal size for readable labels and supports reactive.
#' @param height Height of the plot in cm. Defaults to minimal size for readable labels and supports reactive.
#' @param ppi Pixel per inch. Defaults to 72 and supports reactive.
#' @param scale Scale plot size. Defaults to 1, supports reactive.
#'
#' @details Width/ height/ ppi less or equal to default will use default value.
#' @details Ppi less or equal to zero will use default.
Expand All @@ -106,7 +107,7 @@ geneViewUI <- function(id, plot.columns = 3){
#'
#' @export

geneView <- function(input, output, session, data, metadata, level = NULL, plot.method = "static", custom.label = NULL, label.sep = ", ", width = "auto", height = "auto", ppi = 72){
geneView <- function(input, output, session, data, metadata, level = NULL, plot.method = "static", custom.label = NULL, label.sep = ", ", width = "auto", height = "auto", ppi = 72, scale = 1){
#handle reactive data
data.r <- shiny::reactive({
if(shiny::is.reactive(data)){
Expand Down Expand Up @@ -136,6 +137,7 @@ geneView <- function(input, output, session, data, metadata, level = NULL, plot.
width <- ifelse(shiny::is.reactive(width), width(), width)
height <- ifelse(shiny::is.reactive(height), height(), height)
ppi <- ifelse(shiny::is.reactive(ppi), ppi(), ppi)
scale <- ifelse(shiny::is.reactive(scale), scale(), scale)

if(!is.numeric(width) || width <= 0) {
width <- "auto"
Expand All @@ -149,7 +151,8 @@ geneView <- function(input, output, session, data, metadata, level = NULL, plot.

list(width = width,
height = height,
ppi = ppi)
ppi = ppi,
scale = scale)
})

#Fetch the reactive guide for this module
Expand All @@ -158,6 +161,10 @@ geneView <- function(input, output, session, data, metadata, level = NULL, plot.
rintrojs::introjs(session, options = list(steps = guide()))
})

# clear plot
clearPlot <- shiny::reactiveVal(FALSE)

# reset
shiny::observeEvent(input$reset, {
log_message("GeneView: reset", "INFO", token = session$token)

Expand All @@ -172,6 +179,7 @@ geneView <- function(input, output, session, data, metadata, level = NULL, plot.
custom_label <<- shiny::callModule(label, "labeller", data = custom.label, sep = label.sep)
}
limiter <<- shiny::callModule(limit, "limit", lower = shiny::reactive(get_limits()[1]), upper = shiny::reactive(get_limits()[2]))
clearPlot(TRUE)
})

get_limits <- shiny::reactive({
Expand Down Expand Up @@ -259,6 +267,7 @@ geneView <- function(input, output, session, data, metadata, level = NULL, plot.

# enable downloadButton
shinyjs::enable("download")
clearPlot(FALSE)

#new progress indicator
progress <- shiny::Progress$new()
Expand Down Expand Up @@ -286,7 +295,8 @@ geneView <- function(input, output, session, data, metadata, level = NULL, plot.
plot.method = plot.method,
width = size()$width,
height = size()$height,
ppi = size()$ppi
ppi = size()$ppi,
scale = size()$scale
)

log_message("GeneView: done.", "INFO", token = session$token)
Expand Down Expand Up @@ -332,33 +342,42 @@ geneView <- function(input, output, session, data, metadata, level = NULL, plot.

if(plot.method == "interactive") {
output$interactive <- plotly::renderPlotly({
log_message("GeneView: render plot interactive", "INFO", token = session$token)
if(clearPlot()) {
return()
} else {
log_message("GeneView: render plot interactive", "INFO", token = session$token)

#progress indicator
progress <- shiny::Progress$new()
on.exit(progress$close())
progress$set(message = "Rendering plot", value = 0)
#progress indicator
progress <- shiny::Progress$new()
on.exit(progress$close())
progress$set(message = "Rendering plot", value = 0)

plot <- plot()$plot
plot <- plot()$plot

progress$set(value = 1)
return(plot)
progress$set(value = 1)
return(plot)
}
})
} else if(plot.method == "static") {
output$static <- shiny::renderPlot(
width = shiny::reactive(plot()$width * (plot()$ppi / 2.54)),
height = shiny::reactive(plot()$height * (plot()$ppi / 2.54)),
{
log_message("GeneView: render plot static", "INFO", token = session$token)
#progress indicator
progress <- shiny::Progress$new()
on.exit(progress$close())
progress$set(message = "Rendering plot", value = 0.3)
if(clearPlot()) {
return()
} else {
log_message("GeneView: render plot static", "INFO", token = session$token)

plot <- plot()$plot
#progress indicator
progress <- shiny::Progress$new()
on.exit(progress$close())
progress$set(message = "Rendering plot", value = 0.3)

progress$set(value = 1)
return(plot)
plot <- plot()$plot

progress$set(value = 1)
return(plot)
}
})
}

Expand Down
64 changes: 41 additions & 23 deletions R/global_cor_heatmap.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -157,13 +157,14 @@ global_cor_heatmapUI <- function(id) {
#' @param width Width of the plot in cm. Defaults to minimal size for readable labels and supports reactive.
#' @param height Height of the plot in cm. Defaults to minimal size for readable labels and supports reactive.
#' @param ppi Pixel per inch. Defaults to 72 and supports reactive.
#' @param scale Scale plot size. Defaults to 1, supports reactive.
#'
#'
#'
#' @return Reactive containing data used for plotting.
#'
#' @export
global_cor_heatmap <- function(input, output, session, data, types, plot.method = "static", width = "auto", height = "auto", ppi = 72) {
global_cor_heatmap <- function(input, output, session, data, types, plot.method = "static", width = "auto", height = "auto", ppi = 72, scale = 1) {
# load module -------------------------------------------------------------
# handle reactive data
data_r <- shiny::reactive({
Expand All @@ -180,6 +181,7 @@ global_cor_heatmap <- function(input, output, session, data, types, plot.method
width <- ifelse(shiny::is.reactive(width), width(), width)
height <- ifelse(shiny::is.reactive(height), height(), height)
ppi <- ifelse(shiny::is.reactive(ppi), ppi(), ppi)
scale <- ifelse(shiny::is.reactive(scale), scale(), scale)

if(!is.numeric(width) || width <= 0) {
width <- "auto"
Expand All @@ -197,7 +199,8 @@ global_cor_heatmap <- function(input, output, session, data, types, plot.method

list(width = width,
height = height,
ppi = ppi)
ppi = ppi,
scale = scale)
})

# load internal modules
Expand All @@ -217,6 +220,9 @@ global_cor_heatmap <- function(input, output, session, data, types, plot.method
}

# functionality -----------------------------------------------------------
# clear plot
clearPlot <- shiny::reactiveVal(FALSE)

# reset ui
shiny::observeEvent(input$reset, {
log_message("Global correlation heatmap: reset", "INFO", token = session$token)
Expand All @@ -232,6 +238,7 @@ global_cor_heatmap <- function(input, output, session, data, types, plot.method
columns <<- shiny::callModule(columnSelector, "select", type.columns = types, columnTypeLabel = "Column types to choose from")
transform <<- shiny::callModule(transformation, "transform", data = shiny::reactive(as.matrix(data_r()[, columns$selectedColumns(), with = FALSE])))
colorPicker <<- shiny::callModule(colorPicker2, "color", distribution = shiny::reactive(tolower(input$distribution)), winsorize = shiny::reactive(equalize(result_data()[, -1])))
clearPlot(TRUE)
})

# warning if plot size exceeds limits
Expand Down Expand Up @@ -312,6 +319,8 @@ global_cor_heatmap <- function(input, output, session, data, types, plot.method

# enable downloadButton
shinyjs::enable("download")
# show plot
clearPlot(FALSE)

# progress indicator
progress <- shiny::Progress$new()
Expand Down Expand Up @@ -350,7 +359,8 @@ global_cor_heatmap <- function(input, output, session, data, types, plot.method
height = size()$height,
ppi = size()$ppi,
plot.method = plot.method,
winsorize.colors = colorPicker()$winsorize
winsorize.colors = colorPicker()$winsorize,
scale = size()$scale
)

# update progress indicator
Expand All @@ -366,38 +376,46 @@ global_cor_heatmap <- function(input, output, session, data, types, plot.method
width = shiny::reactive(plot()$width * (plot()$ppi / 2.54)),
height = shiny::reactive(plot()$height * (plot()$ppi / 2.54)),
{
log_message("Global correlation heatmap: render plot static", "INFO", token = session$token)
if(clearPlot()) {
return()
} else {
log_message("Global correlation heatmap: render plot static", "INFO", token = session$token)

# progress indicator
progress <- shiny::Progress$new()
on.exit(progress$close())
progress$set(0.2, message = "Rendering plot")
# progress indicator
progress <- shiny::Progress$new()
on.exit(progress$close())
progress$set(0.2, message = "Rendering plot")

# get plot
plot <- plot()$plot
# get plot
plot <- plot()$plot

# update progress indicator
progress$set(1)
# update progress indicator
progress$set(1)

# draw plot
return(ComplexHeatmap::draw(plot, heatmap_legend_side = "bottom"))
# draw plot
return(ComplexHeatmap::draw(plot, heatmap_legend_side = "bottom"))
}
}
)
}else if(plot.method == "interactive") {
output$interactive <- plotly::renderPlotly({
log_message("Global correlation heatmap: render plot interactive", "INFO", token = session$token)
if(clearPlot()) {
return()
} else {
log_message("Global correlation heatmap: render plot interactive", "INFO", token = session$token)

# progress indicator
progress <- shiny::Progress$new()
on.exit(progress$close())
progress$set(0.2, message = "Rendering plot")
# progress indicator
progress <- shiny::Progress$new()
on.exit(progress$close())
progress$set(0.2, message = "Rendering plot")

plot <- plot()$plot
plot <- plot()$plot

# update progress indicator
progress$set(1)
# update progress indicator
progress$set(1)

return(plot)
return(plot)
}
})
}

Expand Down
55 changes: 36 additions & 19 deletions R/heatmap.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -103,11 +103,12 @@ heatmapUI <- function(id, row.label = TRUE) {
#' @param width Width of the plot in cm. Defaults to minimal size for readable labels and supports reactive.
#' @param height Height of the plot in cm. Defaults to minimal size for readable labels and supports reactive.
#' @param ppi Pixel per inch. Defaults to 72 and supports reactive.
#' @param scale Scale plot size. Defaults to 1, supports reactive.
#'
#' @return Reactive containing data used for plotting.
#'
#' @export
heatmap <- function(input, output, session, data, types, plot.method = "static", custom.row.label = NULL, label.sep = ", ", width = "auto", height = "auto", ppi = 72) {
heatmap <- function(input, output, session, data, types, plot.method = "static", custom.row.label = NULL, label.sep = ", ", width = "auto", height = "auto", ppi = 72, scale = 1) {
# cluster limitation
static <- 11000
interactive <- 3000
Expand All @@ -125,6 +126,7 @@ heatmap <- function(input, output, session, data, types, plot.method = "static",
width <- ifelse(shiny::is.reactive(width), width(), width)
height <- ifelse(shiny::is.reactive(height), height(), height)
ppi <- ifelse(shiny::is.reactive(ppi), ppi(), ppi)
scale <- ifelse(shiny::is.reactive(scale), scale(), scale)

if(!is.numeric(width) || width <= 0) {
width <- "auto"
Expand All @@ -142,7 +144,8 @@ heatmap <- function(input, output, session, data, types, plot.method = "static",

list(width = width,
height = height,
ppi = ppi)
ppi = ppi,
scale = scale)
})

# Fetch the reactive guide for this module
Expand Down Expand Up @@ -205,7 +208,10 @@ heatmap <- function(input, output, session, data, types, plot.method = "static",
}
})

#reset ui
# clear plot
clearPlot <- shiny::reactiveVal(FALSE)

# reset ui
shiny::observeEvent(input$reset, {
log_message("Heatmap: reset", "INFO", token = session$token)

Expand All @@ -222,6 +228,7 @@ heatmap <- function(input, output, session, data, types, plot.method = "static",
if(!is.null(custom.row.label)) {
custom_label <<- shiny::callModule(label, "labeller", data = custom.row.label, label = "Select row label", sep = label.sep, disable = shiny::reactive(!input$row.label))
}
clearPlot(TRUE)
})

columns <- shiny::callModule(columnSelector, "select", type.columns = types, columnTypeLabel = "Column types to choose from")
Expand Down Expand Up @@ -253,6 +260,7 @@ heatmap <- function(input, output, session, data, types, plot.method = "static",

# enable downloadButton
shinyjs::enable("download")
clearPlot(FALSE)

#new progress indicator
progress <- shiny::Progress$new()
Expand Down Expand Up @@ -281,6 +289,7 @@ heatmap <- function(input, output, session, data, types, plot.method = "static",
width = size()$width,
height = size()$height,
ppi = size()$ppi,
scale = size()$scale,
plot.method = plot.method,
winsorize.colors = colorPicker()$winsorize
)
Expand All @@ -297,18 +306,22 @@ heatmap <- function(input, output, session, data, types, plot.method = "static",
})

output$interactive <- plotly::renderPlotly({
log_message("Heatmap: render plot interactive", "INFO", token = session$token)
if(clearPlot()) {
return()
} else {
log_message("Heatmap: render plot interactive", "INFO", token = session$token)

#new progress indicator
progress <- shiny::Progress$new()
on.exit(progress$close())
progress$set(0.2, message = "Render plot")
#new progress indicator
progress <- shiny::Progress$new()
on.exit(progress$close())
progress$set(0.2, message = "Render plot")

plot <- plot()$plot
plot <- plot()$plot

progress$set(1)
progress$set(1)

return(plot)
return(plot)
}
})
}else{
output$heatmap <- shiny::renderUI({
Expand All @@ -319,17 +332,21 @@ heatmap <- function(input, output, session, data, types, plot.method = "static",
width = shiny::reactive(plot()$width * (plot()$ppi / 2.54)),
height = shiny::reactive(plot()$height * (plot()$ppi / 2.54)),
{
log_message("Heatmap: render plot static", "INFO", token = session$token)
if(clearPlot()) {
return()
} else {
log_message("Heatmap: render plot static", "INFO", token = session$token)

#new progress indicator
progress <- shiny::Progress$new()
on.exit(progress$close())
progress$set(0.2, message = "Render plot")
#new progress indicator
progress <- shiny::Progress$new()
on.exit(progress$close())
progress$set(0.2, message = "Render plot")

plot <- plot()$plot
plot <- plot()$plot

progress$set(1)
return(ComplexHeatmap::draw(plot, heatmap_legend_side = "bottom"))
progress$set(1)
return(ComplexHeatmap::draw(plot, heatmap_legend_side = "bottom"))
}
})
}

Expand Down
Loading

0 comments on commit 6d62324

Please sign in to comment.