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

Review requests #16

Merged
merged 4 commits into from
May 29, 2018
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
14 changes: 13 additions & 1 deletion R/featureSelector.R
Original file line number Diff line number Diff line change
Expand Up @@ -28,6 +28,7 @@ featureSelectorUI <- function(id){
shiny::actionButton(ns("select"), "Select", style = "color: #fff; background-color: #3c8dbc"),
shiny::actionButton(ns("reset"), "Reset", style = "color: #fff; background-color: #3c8dbc"),
shiny::actionButton(ns("guide"), "Launch guide", style = "color: #fff; background-color: #3c8dbc", icon = shiny::icon("question-circle")),
shiny::downloadButton(ns("download")),
shiny::br("The SELECT button only evaluates the filter(s) below. Sorting or sub-selections based on the table above will reset!")
)

Expand Down Expand Up @@ -316,6 +317,16 @@ featureSelector <- function(input, output, session, data, features = NULL, featu
data_change(1)
})

# download #####
output$download <- shiny::downloadHandler(
filename = "subset.tsv",
content = function(file) {
log_message("FeatureSelector: download", "INFO", token = session$token)

data.table::fwrite(x = result()$data, file = file, sep = "\t")
}
)

return(result)
}

Expand All @@ -338,7 +349,8 @@ featureSelectorGuide <- function(session, grouping = FALSE) {
So in order to apply a filter and create a specific subset adjust the selectors as needed.<br/>
The sum of those adjustments will be the filter used in the next step.",
"guide_buttons" = "<h4>Apply filter</h4>
After the filter is set as intended, click on 'select' to filter the dataset, or click on 'reset' to delete the current filter.",
After the filter is set as intended, click on 'select' to filter the dataset, or click on 'reset' to delete the current filter.<br/>
Download the current subset via the respecting 'Download' Button (includes reorder, text search & row selection).",
"guide_table" = "<h4>Further limit dataset</h4>
Once the filter is successfully applied the remaining data is shown in this table.<br/>
<br/>
Expand Down
23 changes: 17 additions & 6 deletions R/function.R
Original file line number Diff line number Diff line change
Expand Up @@ -1112,37 +1112,38 @@ searchData <- function(input, choices, options = c("=", "<", ">"), min. = min(ch
#' @param width in centimeter.
#' @param height in centimeter.
#' @param ppi pixel per inch. Defaults to 72.
#' @param save_plot Logical if plot object should be saved as .RData.
#' @param ui List of user inputs. Will be converted to Javascript Object Notation. See \code{\link[RJSONIO]{toJSON}}
#'
#' @return See \code{\link[utils]{zip}}.
download <- function(file, filename, plot, width, height, ppi = 72, ui = NULL) {
download <- function(file, filename, plot, width, height, ppi = 72, save_plot = TRUE, ui = NULL) {
# cut off file extension
name <- sub("(.*)\\..*$", replacement = "\\1", filename)

# create tempfile names
plot_file_pdf <- tempfile(pattern = name, fileext = ".pdf")
plot_file_png <- tempfile(pattern = name, fileext = ".png")
if(!is.null(ui)) {
if (!is.null(ui)) {
selection_file <- tempfile(pattern = "selection", fileext = ".json")
} else {
selection_file <- NULL
}

# save plots depending on given plot object
if(ggplot2::is.ggplot(plot)) {
if (ggplot2::is.ggplot(plot)) {
# ggplot

ggplot2::ggsave(plot_file_pdf, plot = plot, width = width, height = height, units = "cm", device = "pdf", useDingbats = FALSE)
ggplot2::ggsave(plot_file_png, plot = plot, width = width, height = height, units = "cm", device = "png", dpi = ppi)
} else if(class(plot)[1] == "plotly") {
} else if (class(plot)[1] == "plotly") {
# plotly
# change working directory temporary so mounted drives are not a problem
wd <- getwd()
setwd(tempdir())
plotly::export(p = plot, file = plot_file_pdf)
plotly::export(p = plot, file = plot_file_png)
setwd(wd)
} else if(class(plot) == "Heatmap") { # TODO: find better way to check for complexHeatmap object
} else if (class(plot) == "Heatmap") { # TODO: find better way to check for complexHeatmap object
# complexHeatmap
grDevices::pdf(plot_file_pdf, width = width / 2.54, height = height / 2.54, useDingbats = FALSE) # cm to inch
ComplexHeatmap::draw(plot, heatmap_legend_side = "bottom")
Expand All @@ -1156,7 +1157,7 @@ download <- function(file, filename, plot, width, height, ppi = 72, ui = NULL) {
files <- c(plot_file_pdf, plot_file_png)

# save user input
if(!is.null(selection_file)) {
if (!is.null(selection_file)) {
# make key = value pair using value of name variable
ui_list <- list()
ui_list[[name]] <- ui
Expand All @@ -1167,6 +1168,16 @@ download <- function(file, filename, plot, width, height, ppi = 72, ui = NULL) {
files <- c(files, selection_file)
}

# save plot object
if (save_plot) {
# create temp file name
plot_object_file <- tempfile(pattern = "plot_object", fileext = ".RData")

save(plot, file = plot_object_file)

files <- c(files, plot_object_file)
}

# create zip file
utils::zip(zipfile = file, files = files, flags = "-j") # discard file path
}
5 changes: 4 additions & 1 deletion man/download.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.