R - Download Filtered Datatable - r

I would like to be able to download a datatable after it is filtered using it's built in search. Either that or be able to filter a dataframe using the same kind of search used in a datatable and access the search on a datatable.

If you use client side processing, you can accomplish this with the input object input[["tablename_rows_all"]]. (append _rows_all to the name of the datatable output slot)
The _rows_all object will return the row indices of your data frame. You can use that within your downloadHandler to subset the data frame when the download is initiated.
library(shiny)
library(DT)
shinyApp(
ui =
shinyUI(
fluidPage(
DT::dataTableOutput("dt"),
p("Notice that the 'rows_all' attribute grabs the row indices of the data."),
verbatimTextOutput("filtered_row"),
downloadButton(outputId = "download_filtered",
label = "Download Filtered Data")
)
),
server =
shinyServer(function(input, output, session){
output$dt <-
DT::renderDataTable(
datatable(mtcars,
filter = "top"),
server = FALSE
)
output$filtered_row <-
renderPrint({
input[["dt_rows_all"]]
})
output$download_filtered <-
downloadHandler(
filename = "Filtered Data.csv",
content = function(file){
write.csv(mtcars[input[["dt_rows_all"]], ],
file)
}
)
})
)

Related

Reactive CSV selection then used in function as df

I am new to shiny and trying to combine a couple features and having some trouble.
I want for the user to be able to select a CSV and then be presented with a random instance (in this case tweet) from that table. The following code worked when "tweetData" was a statically loaded csv using read_csv.
## function to return random row number from data set
getTweet <- function(){
tweetData[sample(nrow(tweetData), 1), ]
}
function(input, output, session) {
## set reactive values, get randomized tweet
appVals <- reactiveValues(
tweet = getTweet(),
ratings = data.frame(tweet = character(), screen_name = character(), rating = character())
)
I want to instead use a dynamically chosen csv for "tweetData", something like adding this??
csvName <- reactive(paste0('../folder_path/', input$file_name))
selectedData <- read.csv(csvName)
How can use reactively chosen csvs to fit into the structure of the first code chunk?
You might be looking for fileInput for giving user an option to upload a dataset.
This is a simple reproducible example -
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput("file1", "Choose CSV File"),
),
mainPanel(
tableOutput("contents")
)
)
)
server <- function(input, output) {
output$contents <- renderTable({
req(input$file1)
read.csv(input$file1$datapath)
})
}
shinyApp(ui, server)

Download a table created in Shiny

I need to give users a set of 60 observations. I have a master table that I want to to subset these 60 observations from. So, (1) I host the master table as a published csv file on google drive. (2) Write a shiny code to subset 60 values in R studio. The user will have to enter a group ID that I use as set.seed and ensure that the user sees the same subset every time he / she attempts to get the 60 observations. And, it also helps me keep track of the observations that the user has.
The code works fine and I am able to show the subset table. But, I am not able to get the download to work. I saw a post that says renderTable create an HTML table that cannot be downloaded and I should create the table outside it. I tried using reactive to do this, but it did not work and kept giving various errors. For example:
"cannot coerce class ‘c("reactiveExpr", "reactive", "function")’ to a data.frame"
Will appreciate any help of this - even if someone can please point out to what I should read and try to make this work.
library(shiny)
db1 <- read.csv("https://docs.google.com/spreadsheets/d/e/2PACX-1vS94xYLix6bDUNNXAgHejdQ-CcWi-G4t25nfxuhRZF57TloC8NwVgnperBB9-U-IuDvMcOnvdc9iavU/pub?gid=0&single=true&output=csv")
# Define UI
ui <- fluidPage(
# Application title
titlePanel("MnM"),
# Sidebar to take input of group ID
sidebarLayout(
sidebarPanel(
numericInput("seed","Group ID:", value = 100, min = 100, max = 999),
downloadButton("downloadData", "Download")
),
# Show the table
mainPanel(
tableOutput("table")
)
)
)
# Define server logic for the table
server <- function(input, output) {
output$table <- renderTable({
set.seed(input$seed)
zz <- sample(1:nrow(db1), size = 60, replace = TRUE)
data.frame(db1[zz,])})
output$downloadData <- downloadHandler(
filename = "test.csv",
content = function(file) {
write.csv(output$table, file, row.names = FALSE)
}
)
}
# Run the application
shinyApp(ui = ui, server = server)
Create your table once, and then use it in your renderTable and downloadHandler. Create it as a reactive, so its available everywhere.
Note that downloadHandler doesn't work in RStudio's preview, view it in a browser instead. There is a button labelled 'Open in Browser' that will do this.
Here is your code with that applied:
library(shiny)
db1 <- read.csv("https://docs.google.com/spreadsheets/d/e/2PACX-1vS94xYLix6bDUNNXAgHejdQ-CcWi-G4t25nfxuhRZF57TloC8NwVgnperBB9-U-IuDvMcOnvdc9iavU/pub?gid=0&single=true&output=csv")
# Define UI
ui <- fluidPage(
# Application title
titlePanel("MnM"),
# Sidebar to take input of group ID
sidebarLayout(
sidebarPanel(
numericInput("seed","Group ID:", value = 100, min = 100, max = 999),
downloadButton("downloadData", "Download")
),
# Show the table
mainPanel(
tableOutput("table")
)
)
)
# Define server logic for the table
server <- function(input, output) {
#Create dataframe
mytable <- reactive({
set.seed(input$seed)
zz <- sample(1:nrow(db1), size = 60, replace = TRUE)
data.frame(db1[zz,])
})
#Display dataframe in table
output$table <- renderTable({
mytable()
})
#Download dataframe
output$downloadData <- downloadHandler(
filename = "test.csv",
content = function(file) {
write.csv(mytable(), file, row.names = FALSE)
}
)
}
# Run the application
shinyApp(ui = ui, server = server)

Downloading the outputs of a reactive table in R shiny

I have an R shiny app that gets a .csv import from a user and searches the imported data across a built-in data frame, then gives the % match in the output. The UI is very simple, with a few different inputs (import .csv, a slider, and some radio buttons). What I want is to be able to take the reactive table output and print this to a .csv that the user can download to their machine. The server side of the app looks something like this:
server <- function(input, output){
rvals <- reactiveValues()
observeEvent(input$file_1,{
req(input$file_1)
rvals$csv <<- read.csv(input$file_1$datapath, header = TRUE)
#some data processing here
})
output$contents <- renderTable({
if(input$select == 1){
x <- function
}else if(input$select == 2){
x <- function
}else if(input$select == 3){x <- function}
#some more data processing and formatting here
return(x)
},digits = 4)
}
I would like to have the data table x be able to become a .csv that can be downloaded by clicking a download button. In the server, I added the following code, but when I try to download the data it just downloads a blank file and says "SERVER ERROR" in my downloads manager on my machine.
output$downloadData <- downloadHandler(
filename = "thename.csv",
content = function(file){
write.csv(x, file)
}
In the console I also get the error message:
Warning: Error in is.data.frame: object 'x' not found [No stack trace available]
The object you create inside the expression of renderTable is not available outside of it. Instead you could assign it to the reactive values you set up. Below is a working example (note that I have tried to replicate your code so the data will not be available until you click on "Upload CSV", which here just calls mtcars).
library(shiny)
ui = fluidPage(
sidebarPanel(
actionButton(inputId = "uploadCsv", label = "Upload CSV:", icon = icon("upload")),
selectInput(inputId = "preProc", label = "Pre-processing", choices = c("Mean"=1,"Sum"=2)),
downloadButton("downloadData", label = "Download table")
),
mainPanel(
h4("My table:"),
tableOutput("contents")
)
)
server <- function(input, output) {
rvals <- reactiveValues(
csv=NULL,
x=NULL
)
observeEvent(input$uploadCsv,{
rvals$csv <- mtcars # using example data since I don't have your .csv
# rvals$csv <- read.csv(input$file_1$datapath, header = TRUE)
#some data processing here
})
output$contents <- renderTable({
# Assuing the below are functions applied to your data
req(
input$preProc,
!is.null(rvals$csv)
)
if(input$preProc == 1){
rvals$x <- data.frame(t(colMeans(mtcars)))
}else {
rvals$x <- data.frame(t(colSums(mtcars)))
}
return(rvals$x)
},digits = 4)
output$downloadData <- downloadHandler(
filename = "myFile.csv",
content = function(file){
write.csv(rvals$x, file)
}
)
}
shinyApp(ui,server)
EventReactive already outputs a reactive value, you don't need to create an extra reactiveVal, see example below :
library(shiny)
# Define UI
ui <- fluidPage(
# Application title
titlePanel("Test"),
mainPanel(
actionButton("show", "Download"),
textOutput("result")
)
)
server <- function(input, output) {
csvfile <- eventReactive(req(input$show), ignoreNULL = T, {
"Content of file"
})
output$result <- reactive(
paste("result : ",csvfile()))
}
# Run the application
shinyApp(ui = ui, server = server)
I would also avoid to use <<-operator in a reactive expression.

'Select All' checkbox for Shiny DT::renderDataTable

I want a checkbox that selects all the rows displayed (displayed is key as this differs between the filters you have applied and the entire data table) in a standard DT::renderDataTable in Shiny.
Is there any DT extension that already does this? My coding skills are basic so I cannot write an equivalent Java or HTML code.
This is my app so far, any csv file is compatible for the select all purpose. At the moment there is a clunky way of creating another table of all the selected rows (manually selected one by one) - this is difficult when you want to select 30 animals all with the same characteristic.
library(shiny)
library(shinyjs)
library(DT)
library(dplyr)
library(data.table)
ui = pageWithSidebar(
headerPanel(""),
#This is where the full animal information file is input, as a ".txt" file.
sidebarPanel(
fileInput("ani", "Upload Animal Information File", accept = ".csv"),
br(),
numericInput("groups","Number of Ewe Groups", value = 1 ),
#This is a list of the table headers. These headers can be indivdually selected to be part of the concatenated "Unique ID" single column.
uiOutput("choose_columns"),
width = 2),
mainPanel(
DT::dataTableOutput("ani1"),
DT::dataTableOutput("selectedEwes")
))
server = function(input, output, session) {
animalinformation <- reactive({
file1 <- input$ani
if (is.null(file1))
return(NULL)
#This removes the Ewes and Status non-zero Rams from the displayed data, so that only live/at hand Rams are shown for selection.
isolate({
anifile <- read.csv(file1$datapath, header = TRUE)
anifile <- as.data.frame(anifile)
})
anifile
})
output$choose_columns <- renderUI({
if (is.null(animalinformation()))
return()
colnames <- names(animalinformation())
# Create the checkboxes and select them all by default
checkboxGroupInput("columns", "Choose Columns",
choices = colnames,
selected = colnames)
})
#This line is repsonsible for creating the table for display.
output$ani1 = DT::renderDataTable({
if (is.null(animalinformation()))
return()
if (is.null(input$columns) || !(input$columns %in% names(animalinformation()))) { return() }
{ datatable(animalinformation()[, input$columns, drop = F], filter = "top") }
})
ani1_selected <- reactive({
ids <- input$ani1_rows_selected
animalinformation()[ids,]
})
#This displays the table of selected rows from the table of Rams. This table can be downloaded or printed, or copied using the buttons that appear above the table, thanks to the 'Buttons' extension.
output$selectedEwes <- DT::renderDataTable({
datatable(
ani1_selected(),
selection = list(mode = "none"),
caption = "Copy to clipboard, download a .csv or print the following table of selected Ewes, using the above buttons.", extensions = 'Buttons', options = list(dom = 'Bfrtip', buttons = c('copy', 'csv', 'excel', 'pdf', 'print'))
)
})
}
shinyApp(ui = ui, server = server)
Any help would be much appreciated thanks.
Here is the simplest implementation I can think of. It takes advantage of the fact that DT will return the filter row indexes back to R, which is input$dt_rows_all in the below example. Moreover, it uses the DT::dataTableProxy() to control the row selection. Finally, it works in both the client mode and the server-side processing mode.
By the way, I want to mention that using javascript to mimic the selecting / deselecting events in DT won't change the related shiny binding values in R (e.g., input$dt_rows_selected). It's because DT has its own implementation of row selections (may change in the future but not yet at the time of writing). See rstudio/DT#366 if you want to know more.
library(shiny)
ui <- tagList(
DT::DTOutput("dt"),
checkboxInput("dt_sel", "sel/desel all"),
h4("selected_rows:"),
verbatimTextOutput("selected_rows", TRUE)
)
server <- function(input, output, session) {
dat <- reactive({iris})
output$dt <- DT::renderDT(dat(), server = TRUE)
dt_proxy <- DT::dataTableProxy("dt")
observeEvent(input$dt_sel, {
if (isTRUE(input$dt_sel)) {
DT::selectRows(dt_proxy, input$dt_rows_all)
} else {
DT::selectRows(dt_proxy, NULL)
}
})
output$selected_rows <- renderPrint(print(input$dt_rows_selected))
}
shiny::runApp(list(ui = ui, server = server))

Reset row selection for DT::renderDataTable() in Shiny R

I reproduced an example shiny app written by Yihui Xie (https://yihui.shinyapps.io/DT-rows/). The app uses DT::renderDataTable() which allows a row selection.
Everything works perfectly fine. I was however wondering if it's possible to reset the row selection (i.e. undo the click selection) ? I already tried it with an action button to reset s = input$x3_rows_selected (see script below).
With my current script,s = input$x3_rows_selected does indeed get emptied, I can however not refill it. Also the selected rows are still clicked (shaded)
Does anyone has an idea? Is there an option within DT::renderDataTable() to reset the selection? Or does anyone has an idea for a workaround?
Thank you!
Example form https://yihui.shinyapps.io/DT-rows/) with my modification (action button):
server.R
library(shiny)
library(DT)
shinyServer(function(input, output, session) {
# you must include row names for server-side tables
# to be able to get the row
# indices of the selected rows
mtcars2 = mtcars[, 1:8]
output$x3 = DT::renderDataTable(mtcars2, rownames = TRUE, server = TRUE)
# print the selected indices
selection <- reactive({
if (input$resetSelection)
vector() else input$x3_rows_selected
})
output$x4 = renderPrint({
if (length(selection())) {
cat("These rows were selected:\n\n")
output <- selection()
cat(output, sep = "\n")
}
})
})
ui.R
library(shiny)
shinyUI(
fluidPage(
title = 'Select Table Rows',
h1('A Server-side Table'),
fluidRow(
column(9, DT::dataTableOutput('x3')),
column(3, verbatimTextOutput('x4'),
actionButton('resetSelection',
label = "Click to reset row selection"
) # end of action button
) #end of column
)))
In the current development version of DT (>= 0.1.16), you can use the method selectRows() to clear selections. Please see the section "Manipulate An Existing DataTables Instance" in the documentation.
Here is a possible solution, maybe not the best but it works. It is based on re-create the datatable each time the action button is clicked, so the selected rows are removed.
library(shiny)
library(DT)
runApp(list(
server = function(input, output, session) {
mtcars2 = mtcars[, 1:8]
output$x3 = DT::renderDataTable({
# to create a new datatable each time the reset button is clicked
input$resetSelection
mtcars2
}, rownames = TRUE, server = TRUE
)
# print the selected indices
selection <- reactive ({
input$x3_rows_selected
})
output$x4 = renderPrint({
if (length(selection())) {
cat('These rows were selected:\n\n')
output <- selection()
cat(output, sep = '\n')
}
})
},
ui = shinyUI(fluidPage(
title = 'Select Table Rows',
h1('A Server-side Table'),
fluidRow(
column(9, DT::dataTableOutput('x3')),
column(3, verbatimTextOutput('x4'),
actionButton( 'resetSelection',label = "Click to reset row selection")
) #end of column
)
))
))

Resources