rhandsontable on multiple tables from SQlite database - r

Assistance will be greatly appreciated.
I am working on a shiny app which involves the use of both multiple SQlite databases and rhandsontable package. I found alot of helpful material online with respect to using this package but I am at a level of frustration as I spend 2 days stuck on one problem which I think its worth asking.
So the script below depicts the server and the UI of the rhandsontable. I wanted to be able to enable the user edit, and safe their modified table (which is covered alot online) but across multiple tables (something I am struggling with)
What my code does is that it opens the 1st table, and yes If i make a modification it does safe. But when I attempt to go to another table through the select input, the other table content immediately gets REPLACED by the initial modified one.
I really would like the modifications to be independent without affecting other tables.
Again, assistance will be greatly appreciated.
downloadTableUI <- function(id) {
ns <- NS(id)
tagList(
sidebarLayout(
sidebarPanel(
selectInput(ns("dataset"), "Choose a dataset:",
choices = dput(as.character(alltables[1: NROW(alltables)]))),
radioButtons(ns("filetype"), "File type:",
choices = c("csv", "tsv")),
dateRangeInput(ns("daterange2"), "Date Filtration",
start = "2017-02-17",
end = "2017-03-07"),
actionButton(ns("saveBtn"), "Save"),
br(),
downloadButton(ns('downloadData'), 'Download File', class = "btn-info")
),
mainPanel(
rHandsontableOutput(ns('tabletest'), width = 730, height = 600)
),
position = c("left")
)
)
}
DownloadTable <- function(input, output, session, pool) {
#select databases
tableChoozer <- reactive({input$dataset})
# dateSelector <- reactive({input$daterange2})
# Initiate the reactive table
p1 <- reactive({
results <- dbGetQuery(pool, paste('select * from ', tableChoozer()))
return (results)
})
Mychanges <- reactive({
observe({
input$saveBtn# update database file each time the button is pressed
if (!is.null(input$tabletest)) {#if there 's a table input
dbWriteTable(pool, tableChoozer(),hot_to_r(input$tabletest), overwrite = TRUE, row.names = FALSE)# overwrite the database
}
})
#THIS IS WHERE I THINK THE PROBLEM IS
if (is.null(input$tabletest)) {
return (p1())
} else if (!identical(p1(), input$tabletest)) {
mytable <- as.data.frame(hot_to_r(input$tabletest))
return (mytable)
}
})
output$tabletest <- renderRHandsontable({
rhandsontable(Mychanges()) %>%
hot_cols(columnSorting = TRUE, highlightCol = TRUE, highlightRow = TRUE,allowRowEdit = FALSE, allowColEdit = FALSE, exportToCsv = TRUE)
})
output$downloadData <- downloadHandler(
filename = function() {
paste("table.csv")
},
content = function(file) {
sep <- switch (input$filetype, "csv" = ",", "tsv" = "\t")
write.table(p1(), file, sep = sep, row.names = FALSE)
}
)
}

This code is untested, but hopefully it will work. Put the following at the top level of your server.R file
observeEvent( input$saveBtn,
{
# update database file each time the button is pressed
if (!is.null(input$tabletest)) {
#if there 's a table input
dbWriteTable(pool, tableChoozer(),
hot_to_r(input$tabletest), overwrite = TRUE, row.names = FALSE)
# overwrite the database
},
ignoreInit = TRUE
)
Using observeEvent rather than observe prevents a reactive dependency on tableChoozer and input$tabletest which seems to be your problem. ignoreInit makes it so the save event is not triggered at the initialization of the savebutton.

Related

R Shiny error - how to download uploaded file after transformation

I would like to be able to upload a dataset, select a set of columns, transform the selected columns (i.e. apply a function), then download the modified file. I have been trying to do so with the following code:
library(shiny)
library(DT)
library(shinyWidgets)
library(plyr)
library(dplyr)
library(RecordLinkage)
library(readxl)
cleanup <- function(x){
x <- as.character(x) # convert to character
x <- tolower(x) # make all lowercase
x <- trimws(x, "both") # trim white space
return(x)
}
ui <- fluidPage(
h2("Record Linkage Data"),
fileInput("file1", "Upload file for cleaning", accept = c("xls", "csv"), multiple = F),
actionButton(inputId = "clean", label = "Clean Data"),
downloadButton("download1", "Download file1"),
pickerInput(width = "75%",
inputId = "pick_col1",
label = "Select columns to display",
choices = colnames(file1),
selected = colnames(file1),
options = list(
`actions-box` = T,
`selected-text-format` = paste("count > ", length(colnames(file1)) - 1),
`count-selected-text` = "Alle",
liveSearch = T,
liveSearchPlaceholder = T
),
multiple = T),
DT::dataTableOutput("mytable")
)
load_path <- function(path) {
req(input$file)
ext <- tools::file_ext(path)
if (ext == "csv"){
read.csv(path, header = T)
} else if (ext == "xls" || ext == "xlsx"){
read_excel(path)
} else{
stop("Unknown extension: '.", ext, "'")
}
}
server <- function(input, output, session){
file1 <- reactive(load_path(input$selection$datapath[[1]]))
#file2 <- reactive(load_path(input$selection$datapath[[2]]))
eventReactive(input$clean, {
output$mytable <- DT::renderDataTable({
data.frame(lapply(select(file1, input$pick_col1), cleanup))
})
})
output$download <- downloadhandler(
filename = function(){
paste0(tools::file_path_sans_ext(input$filename), ".csv")
},
content = function(file){
write.csv(data(), file)
}
)
}
shinyApp(ui, server)
When I run the above code, I get the error : Error in is.data.frame(x) : object 'file1' not found. I am unsure why this is but I have been struggling to understand naming things in shiny. For example: I want to upload file1, then transform it. Do I continue to refer to file1 when I want to download it? These may seem like silly questions but I am asking because I don't know and I'm trying to learn. There seem to be lots of different approaches.
I would like to:
1. Load a file
2. Select columns (pickerInput is what I have been trying, but selectInput would suffice I suppose)
3. via action button, apply a pre-specified function to the selected columns
4. download the transformed dataset as a .csv
I've encountered some problems
It is a very silly one (it happens to all of us). You should write downloadHandler instead of downloadhandler.
The main problem: Your pickerInput is trying to select the column names of the data frame file1 when it does not exists. When you run the application the code is trying to find a file1 data frame and look its column names, but since at that time you haven't uploaded anything yet, it throws an error.
On how you read files: I am not familiar with how you read files, I suggest you do something similar than what is done in this example. https://shiny.rstudio.com/gallery/file-upload.html. Note you need to use a read.* function and point the result to another name, df in the example.
How would I solve it:
1. Set choices and selected options to NULL by default. Something like the following should work:
pickerInput(width = "75%",
inputId = "pick_col1",
label = "Select columns to display",
choices = NULL,
selected = NULL,
options = list(
`actions-box` = T,
# `selected-text-format` = paste("count > ", length(colnames(file1)) - 1),
`count-selected-text` = "Alle",
liveSearch = T,
liveSearchPlaceholder = T
),
multiple = T)
Add an updatePickerInput in the server side within an observeEvent. Something like this should work.
observeEvent(input$file1, {
req(input$file1) # ensure the value is available before proceeding
df <- read.csv(input$file1$datapath)
updatePickerInput(session = session,
inputId = "pick_col1",
choices = colnames(df),
# ... other options)
})
I haven't looked much if there are other problems with the code.
I suggest you start from the example in the link shared and start modifying it until you get what you want.
If that does not work, let me know and I can try to figure it out
Good luck!

How to block or restrict access when a user is already using a Shiny app

I have a Shiny app that uses the Ace editor. Now I would like to have it so that when a first user is using this editor, other users cannot edit the document, but only view the document.
How can this be realized?
The code is:
library(shiny)
library(shinyAce)
library(stringi)
ui <- fluidPage(
br(),
uiOutput("aceEditor1"),
downloadButton('save1', 'Save editor content')
)
server <- function(input, output, session)
{
output$aceEditor1 <- renderUI(
{
aceEditor(outputId = "ace1",
value = paste(stri_rand_lipsum(3), collapse="\n\n"),
mode = "r",
height = "500px",
fontSize = 17,
theme = "chrome",
wordWrap = TRUE)
})
output$save1 <- downloadHandler (
filename = function()
{
"result.txt"
},
content = function(file)
{
write.table(x = input$ace1, file = file, sep = "", row.names = FALSE, col.names = FALSE, quote = FALSE)
}
)
}
shinyApp(ui = ui, server = server)
You can implement this by introducing keys. Essentially, we create a global key variable which is visible to all sessions. When a session starts it takes the key and sets the global variable to be unavailable.
When a new session connects, and attempts to get the key, but it is unavailable.
Within the server function we can check before executing a "critical section" piece of code.
This is essentially the basics of how semiphore flag work.
Finally, when the session ends for the first session, it returns the key to the global variable.
We can also go a step further and use invalidateLater() to periodically check if the key is available.
To run the dummy example below first run this,
write_csv(mtcars,"~/Desktop/data.csv")
And the app is the following:
library(shiny)
key_available <- TRUE
ui <- fluidPage(
br(),
textInput(inputId = "text_input","Text Input"),
actionButton(inputId = "add_col","Add Column"),
dataTableOutput("table_output"),
downloadButton('save1', 'Save editor content')
)
server <- function(input, output, session){
onSessionEnded(function() key_available <<- TRUE)
# Session starts, Read data in
have_key <- FALSE
observe({
invalidateLater(1000)
if(key_available){
key_available <<- FALSE
have_key <<- TRUE
}
})
data_reactive <- eventReactive(c(input$add_col),{
data <- read_csv("~/Desktop/data.csv")
if(have_key){
data[[input$text_input]] <- NA
write_csv(data,"~/Desktop/data.csv")
}
return(data)
})
output$table_output <- renderDataTable({
req(data_reactive())
data_reactive()
})
}
shinyApp(ui = ui, server = server)
Open the first browser window, add a column name in the text box and click on Add Column.
You will notice the column is added. You can continue to do this as this session has the key.
Opening a new browser window simultaneously, and trying to do the above will be unsuccessful. However, if you close the first browser window, you will be able to now edit on the second browser window.

Optimizing Performance - Large File Input in Shiny

I have a function (clawCheck) defined in the file CheckClawback.R which takes three data frames as arguments. In my Shiny app, the user uploads three files which are then read into memory and used as the ClawCheck arguments. In order to save time, I want R to start reading a file into memory as soon as it is uploaded, and not only after the "GO" button is pressed, so that once the button is pressed, the arguments for ClawCheck are already in memory and ready to use.
I'm thinking that I have to use eventReactive expressions within the renderTable statement, since I don't want the files to be re-read every time a user changes some input. To avoid further complication, I assume the input is filled in in order, i.e first "account", then "commpaid", then "termriders". When I run the app and the first input file has been uploaded, there is no progress bar appearing which indicates that my code is not working correctly. Here is my (reduced) code:
library('shiny')
source("CheckClawback.R")
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput("account", "Account File (.csv)"),
fileInput("commpaid", "CommPaid File (.txt)"),
fileInput("termriders", "TermRiders File (.txt)"),
actionButton("do", "GO!")),
mainPanel(
tableOutput("out_table"))
)
)
server <- function(input, output) {
func <- eventReactive(input$do, {
req(acc)
req(comm)
req(term)
datat <<- clawCheck(acc, comm, term)
})
output$out_table <- renderTable({
eventReactive(input$account, {
withProgress(message = "Preparing Account Data...Please Wait", {
acc <<- read.csv(input$account$datapath, header = TRUE, sep = ",")
})
})
eventReactive(input$commpaid, {
withProgress(message = "Preparing CommPaid Data...Please Wait", {
comm <<- read.table(input$commpaid$datapath, header = TRUE, sep = "\t")
})
})
eventReactive(input$termriders, {
withProgress(message = "Preparing TermRiders Data...Please Wait", {
term <<- read.table(input$termriders$datapath, header = TRUE, sep = "\t")
})
})
withProgress(func(), message = "Loading Output...Please Wait")
datat
})
}
shinyApp(ui = ui, server = server)
Ideally, after a file is uploaded, a progress bar should appear, indicating that it is being processed. If, during this process, a second file is uploaded, a second progress bar should appear, indicating that the second file is being processed etc. Once the actual function call happens, I want the input files to be ready to go.
I am very thankful for any help!
Your use of <<- and withProgress() is wrong. Also, using eventReactive() inside a render*() is wrong. I suggest going through RStudio Shiny tutorials to get help on understanding how reactivity works. Also look at showNotification() instead of withProgress(). For now, here's what you probably need -
server <- function(input, output, session) {
acc <- reactive({
validate(need(input$account), "acc not uploaded")
# use showNotification(); use same approach for other files
read.csv(input$account$datapath, header = TRUE, sep = ",")
# use removeNotification() to remove mesg after file is uploaded
})
comm <- reactive({
validate(need(input$commpaid), "comm not uploaded")
read.table(input$commpaid$datapath, header = TRUE, sep = "\t")
})
term <- reactive({
validate(need(input$termriders), "term not uploaded")
read.table(input$termriders$datapath, header = TRUE, sep = "\t")
})
func <- eventReactive(input$do, {
clawCheck(acc(), comm(), term())
})
output$out_table <- renderTable({
func()
})
}

Shiny R observeEvent with Multiple Conditions from selectInput

I'm working on a shiny app and I'm running into difficulty with observeEvent() function when creating a complex expression of multiple inputs that all derive from selectInput().
My issue is some of the expressions within the observeEvent() function are triggered at startup, causing the event to prematurely execute (i.e. my actionButton() is disabled at startup, as it should be, but becomes enabled when at least one of the inputs are selected when ideally I would want it to become enabled only when ALL inputs are selected). As seen below:
observeEvent({
#input$cohort_file
input$cohort_IDvar
input$cohort_index_date
input$cohort_EOF_date
input$cohort_EOF_type
input$cohort_Y_name
input$cohort_L0
}, {
enable("set_cohort_button")
})
For reference, I'm using the shinyjs package by #daattali found on github to enable/disable actionButton().
All but the last input (i.e. input$cohort_L0) appear to be initialized at startup so observeEvent() enables actionButton only when input$cohort_L0 is selected. If you run my app and select input in sequential order from top to bottom, it appears that observeEvent() is working as intended. I only discovered that it wasn't working as intended when I decided to choose inputs at random and discovered that selecting input$cohort_L0 was the only input I needed to select to enable actionButton().
The UI portion of the code looks like this:
# Variable selection
selectInput('cohort_IDvar', 'ID', choices = ''),
selectInput('cohort_index_date', 'Index date', choices = ''),
selectInput('cohort_EOF_date', 'End of follow-up date', choices = ''),
selectInput('cohort_EOF_type', 'End of follow-up reason', choices = ''),
selectInput('cohort_Y_name', 'Outcome', choices = ''),
selectInput('cohort_L0', 'Baseline covariate measurements', choices = '', multiple=TRUE, selectize=TRUE),
And I'm using observe() to collect the column names of an upload data-set to direct them to selectInput() as follows:
### Collecting column names of dataset and making them selectable input
observe({
value <- c("",names(cohort_data()))
updateSelectInput(session,"cohort_IDvar",choices = value)
updateSelectInput(session,"cohort_index_date",choices = value)
updateSelectInput(session,"cohort_EOF_date",choices = value)
updateSelectInput(session,"cohort_EOF_type",choices = value)
updateSelectInput(session,"cohort_L0",choices = value)
})
I've looked into using the argument ignoreInit = TRUE but it does nothing for my case of having multiple expressions within observeEvent(). I've also looked into forcing no default selection in selectInput() but had no luck with that.
So my two-part question is how can I execute observEvent() when only ALL inputs are selected/how do I stop from the inputs from being initialized at startup?
My entire code:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
navbarPage("Test",
tabPanel("Cohort",
sidebarLayout(
sidebarPanel(
fileInput("cohort_file", "Choose CSV File",
multiple = FALSE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
# Horizontal line ----
tags$hr(),
# Variable selection
selectInput('cohort_IDvar', 'ID', choices = ''),
selectInput('cohort_index_date', 'Index date', choices = ''),
selectInput('cohort_EOF_date', 'End of follow-up date', choices = ''),
selectInput('cohort_EOF_type', 'End of follow-up reason', choices = ''),
selectInput('cohort_Y_name', 'Outcome', choices = ''),
selectInput('cohort_L0', 'Baseline covariate measurements', choices = '', multiple=TRUE, selectize=TRUE),
# Horizontal line ----
tags$hr(),
disabled(
actionButton("set_cohort_button","Set cohort")
)
#actionButton("refresh_cohort_button","Refresh")
),
mainPanel(
DT::dataTableOutput("cohort_table"),
tags$div(id = 'cohort_r_template')
)
)
)
)
)
server <- function(input, output, session) {
################################################
################# Cohort code
################################################
cohort_data <- reactive({
inFile_cohort <- input$cohort_file
if (is.null(inFile_cohort))
return(NULL)
df <- read.csv(inFile_cohort$datapath,
sep = ',')
return(df)
})
rv <- reactiveValues(cohort.data = NULL)
rv <- reactiveValues(cohort.id = NULL)
rv <- reactiveValues(cohort.index.date = NULL)
rv <- reactiveValues(cohort.eof.date = NULL)
rv <- reactiveValues(cohort.eof.type = NULL)
### Creating a reactiveValue of the loaded dataset
observeEvent(input$cohort_file, rv$cohort.data <- cohort_data())
### Displaying loaded dataset in UI
output$cohort_table <- DT::renderDataTable({
df <- cohort_data()
DT::datatable(df,options=list(scrollX=TRUE, scrollCollapse=TRUE))
})
### Collecting column names of dataset and making them selectable input
observe({
value <- c("",names(cohort_data()))
updateSelectInput(session,"cohort_IDvar",choices = value)
updateSelectInput(session,"cohort_index_date",choices = value)
updateSelectInput(session,"cohort_EOF_date",choices = value)
updateSelectInput(session,"cohort_EOF_type",choices = value)
updateSelectInput(session,"cohort_L0",choices = value)
})
### Creating selectable input for Outcome based on End of Follow-Up unique values
observeEvent(input$cohort_EOF_type,{
updateSelectInput(session,"cohort_Y_name",choices = unique(cohort_data()[,input$cohort_EOF_type]))
})
### Series of observeEvents for creating vector reactiveValues of selected column
observeEvent(input$cohort_IDvar, {
rv$cohort.id <- cohort_data()[,input$cohort_IDvar]
})
observeEvent(input$cohort_index_date, {
rv$cohort.index.date <- cohort_data()[,input$cohort_index_date]
})
observeEvent(input$cohort_EOF_date, {
rv$cohort.eof.date <- cohort_data()[,input$cohort_EOF_date]
})
observeEvent(input$cohort_EOF_type, {
rv$cohort.eof.type <- cohort_data()[,input$cohort_EOF_type]
})
### ATTENTION: Following eventReactive not needed for example so commenting out
### Setting id and eof.type as characters and index.date and eof.date as Dates
#cohort_data_final <- eventReactive(input$set_cohort_button,{
# rv$cohort.data[,input$cohort_IDvar] <- as.character(rv$cohort.id)
# rv$cohort.data[,input$cohort_index_date] <- as.Date(rv$cohort.index.date)
# rv$cohort.data[,input$cohort_EOF_date] <- as.Date(rv$cohort.eof.date)
# rv$cohort.data[,input$cohort_EOF_type] <- as.character(rv$cohort.eof.type)
# return(rv$cohort.data)
#})
### Applying desired R function
#set_cohort <- eventReactive(input$set_cohort_button,{
#function::setCohort(data.table::as.data.table(cohort_data_final()), input$cohort_IDvar, input$cohort_index_date, input$cohort_EOF_date, input$cohort_EOF_type, input$cohort_Y_name, input$cohort_L0)
#})
### R code template of function
cohort_code <- eventReactive(input$set_cohort_button,{
paste0("cohort <- setCohort(data = as.data.table(",input$cohort_file$name,"), IDvar = ",input$cohort_IDvar,", index_date = ",input$cohort_index_date,", EOF_date = ",input$cohort_EOF_date,", EOF_type = ",input$cohort_EOF_type,", Y_name = ",input$cohort_Y_name,", L0 = c(",paste0(input$cohort_L0,collapse=","),"))")
})
### R code template output fo UI
output$cohort_code <- renderText({
paste0("cohort <- setCohort(data = as.data.table(",input$cohort_file$name,"), IDvar = ",input$cohort_IDvar,", index_date = ",input$cohort_index_date,", EOF_date = ",input$cohort_EOF_date,", EOF_type = ",input$cohort_EOF_type,", Y_name = ",input$cohort_Y_name,", L0 = c(",paste0(input$cohort_L0,collapse=","),"))")
})
### Disables cohort button when "Set cohort" button is clicked
observeEvent(input$set_cohort_button, {
disable("set_cohort_button")
})
### Disables cohort button if different dataset is loaded
observeEvent(input$cohort_file, {
disable("set_cohort_button")
})
### This is where I run into trouble
observeEvent({
#input$cohort_file
input$cohort_IDvar
input$cohort_index_date
input$cohort_EOF_date
input$cohort_EOF_type
input$cohort_Y_name
input$cohort_L0
}, {
enable("set_cohort_button")
})
### Inserts heading and R template code in UI when "Set cohort" button is clicked
observeEvent(input$set_cohort_button, {
insertUI(
selector = '#cohort_r_template',
ui = tags$div(id = "cohort_insertUI",
h3("R Template Code"),
verbatimTextOutput("cohort_code"))
)
})
### Removes heading and R template code in UI when new file is uploaded or when input is changed
observeEvent({
input$cohort_file
input$cohort_IDvar
input$cohort_index_date
input$cohort_EOF_date
input$cohort_EOF_type
input$cohort_Y_name
input$cohort_L0
}, {
removeUI(
selector = '#cohort_insertUI'
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
The code chunk that you're passing to the observeEvent as the trigger event is
{
input$cohort_IDvar
input$cohort_index_date
input$cohort_EOF_date
input$cohort_EOF_type
input$cohort_Y_name
input$cohort_L0
}
This means that, just like any other reactive code block, when ANY of these values changes, that reactive block is considered invalidated and therefore the observer will trigger. So the behaviour you're seeing makes sense.
It sounds like what you want is to execute only when all values are set. That sounds like a great use of the req() function! Try something like this:
observe({
req(input$cohort_IDvar, input$cohort_index_date, input$cohort_EOF_date, ...)
enable("set_cohort_button")
})
Note that for shinyjs::enable() specifically, you can instead use the shinyjs::toggleState() function. I think in this case the req() function is the better option though.

'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))

Resources