Related
I recently asked a similar question (Shiny DT datatable input reactivity after table is reloaded). My issue was getting a selectInput in a DT datatable to work correctly after the table is reloaded. The solution worked, which was to use javascript to unbind before reloading the table. However, that example used a static dataframe. When the input data in the datatable are reactive, it doesn't work. In the example below, when the user clicks "Update data" the first time to load data, the selectInput works correctly and input$id1 responds to the user selection. However, when the user clicks "Update data" again to update the reactive data, the input$id no longer responds to the user selection. I've seen two potential approaches to address the issue. One is using dataTableProxy() and replaceData(), and the other is renaming the selectInput ids each time the reactive data are updated. I was wondering if I can avoid those two approaches and get this example working with minimal changes.
require(shiny)
require(DT)
shinyApp(
ui = fluidPage(
tags$head(tags$script(
HTML(
"Shiny.addCustomMessageHandler('unbindDT', function(id) {
var $table = $('#'+id).find('table');
if($table.length > 0){
Shiny.unbindAll($table.DataTable().table().node());
}
})")
)),
actionButton(inputId = "update", label = "Update data"),
uiOutput("resettable_table")
),
server = function(input, output, session) {
rv <- reactiveValues(
times = 1,
mydata = NULL
)
observeEvent(input$update, {
session$sendCustomMessage("unbindDT", "mytable")
rv$times <- rv$times + 1
rv$mydata <- data.frame(
Col1 = as.character(selectInput(
inputId = "id1",
label = NULL,
choices = paste0(letters, input$update),
selected = paste0(letters, input$update)[1],
))
)
})
output$mytable <- DT::renderDataTable({
req(rv$mydata)
DT::datatable(
data = rv$mydata,
escape = F,
selection = "none",
options = list(
preDrawCallback = JS('function(){Shiny.unbindAll(this.api().table().node());}'),
drawCallback = JS('function(){Shiny.bindAll(this.api().table().node());}')
)
)
}, server = F)
output$resettable_table <- renderUI({
req(rv$times)
div(
id = paste0("mydiv", rv$times),
DT::dataTableOutput("mytable")
)
})
observe({
if(is.null(input$id1)) {
print("input$id1 is NULL")
} else {
print(paste(c("input$id1:", input$id1)))
}
})
}
)
Update
Thanks to #StephaneLaurent for pointing out that the reactive counter keeping track of the number of times the data were reloaded was causing the issue. It wasn't actually necessary to put the DT datatable inside a div with an id that updated each time. Here is working code:
require(shiny)
require(DT)
shinyApp(
ui = fluidPage(
tags$head(tags$script(
HTML(
"Shiny.addCustomMessageHandler('unbindDT', function(id) {
var $table = $('#'+id).find('table');
if($table.length > 0){
Shiny.unbindAll($table.DataTable().table().node());
}
})")
)),
actionButton(inputId = "update", label = "Update data"),
DT::dataTableOutput("mytable")
),
server = function(input, output, session) {
rv <- reactiveValues(mydata = NULL)
observeEvent(input$update, {
session$sendCustomMessage("unbindDT", "mytable")
rv$mydata <- data.frame(
Col1 = as.character(selectInput(
inputId = "id1",
label = NULL,
choices = paste0(letters, input$update),
selected = paste0(letters, input$update)[1],
))
)
})
output$mytable <- DT::renderDataTable({
req(rv$mydata)
DT::datatable(
data = rv$mydata,
escape = F,
selection = "none",
options = list(
preDrawCallback = JS('function(){Shiny.unbindAll(this.api().table().node());}'),
drawCallback = JS('function(){Shiny.bindAll(this.api().table().node());}')
)
)
}, server = F)
observe({
if(is.null(input$id1)) {
print("input$id1 is NULL")
} else {
print(paste(c("input$id1:", input$id1)))
}
})
}
)
The problem is caused by the presence of rv$times in the renderUI. The simplest way to make this app work is to get rid of this renderUI.
However, for fun, and in order to understand what happens, I did the app below which works with the renderUI and which shows what happens. The key point was to remove the id1 element when the table is consecutively rendered two times, before the second rendering. To do so, I use a JavaScript counter i.
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
tags$head(tags$script(
HTML("var i = 1;")
)),
actionButton(inputId = "update", label = "Update data"),
uiOutput("resettable_table")
),
server = function(input, output, session) {
rv <- reactiveValues(
times = 1,
mydata = NULL
)
observeEvent(input$update, {
rv$times <- rv$times + 1
rv$mydata <- data.frame(
Col1 = as.character(selectInput(
inputId = "id1",
label = NULL,
choices = paste0(letters, input$update),
selected = paste0(letters, input$update)[1],
))
)
})
output$mytable <- DT::renderDataTable({
req(rv$mydata)
DT::datatable(
data = rv$mydata,
escape = F,
selection = "none",
options = list(
initComplete = JS('function(settings) { alert("initComplete - incrementing i"); i++; alert("i = " + i)}'),
preDrawCallback = JS('function() { alert("preDrawCallback triggered - unbinding"); Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() { alert("drawCallback triggered - i = " + i); if(i===2) {alert("removing id1 and resetting i to 0"); $("#id1").remove(); i=0;} Shiny.bindAll(this.api().table().node());}')
)
)
}, server = F)
output$resettable_table <- renderUI({
div(
id = paste0("mydiv", rv$times),
tags$p(paste0("mydiv", rv$times)),
DT::dataTableOutput("mytable")
)
})
observe({
if(is.null(input$id1)) {
print("input$id1 is NULL")
} else {
print(paste(c("input$id1:", input$id1)))
}
})
}
)
I want to make an app with 2 actionButtons: 1) to submit the changes before loading a selectizeInput and 2) to draw the plot.
I know how to add a spinner after clicking a actionButton but the majority of the cases is added when you want to show the plot.
However, is it possible to add a spinner without showing any plot?
In this particular case, I want to show a spinner after clicking "Submit" until the selectizeInput from the 'Selection tab' is loaded. As you can see the example that I attach, it takes a bit to load all the choices (since the file has 25000 rows).
I already have one spinner after clicking the second actionButton (Show the plot) but I need one more.
I have created an example, but for some reason the plot is not shown in the shiny app and it appears in the window from R (I don't know why but I added the plot just to show you how I put the second spinner. I want a similar one but with the first actionButton.).
library(shiny)
library(shinycssloaders)
ui <- fluidPage(
titlePanel("My app"),
sidebarLayout(
sidebarPanel(
tabsetPanel(
tabPanel("Submit",
checkboxInput("log2", "Log2 transformation", value = FALSE),
actionButton("submit", "Submit")
),
tabPanel("Selection",
br(),
selectizeInput(inputId = "numbers", label = "Choose one number:", choices=character(0)),
actionButton("show_plot", "Show the plot")
))
),
mainPanel(
conditionalPanel(
condition = "input.show_plot > 0",
style = "display: none;",
withSpinner( plotOutput("hist"),
type = 5, color = "#0dc5c1", size = 1))
)
)
)
server <- function(input, output, session) {
data <- reactive({
data = read.csv("https://people.sc.fsu.edu/~jburkardt/data/csv/hw_25000.csv")
data[,1] <- as.character(data[,1])
if(input$log2 == TRUE){
cols <- sapply(data, is.numeric)
data[cols] <- lapply(data[cols], function(x) log2(x+1))
}
return(data)
})
mylist <- reactive({
req(data())
data <- data()
data <- data[,1]
return(data)
})
# This is to generate the choices (gene list) depending on the user's input.
observeEvent(input$submit, {
updateSelectizeInput(
session = session,
inputId = "numbers",
choices = mylist(), options=list(maxOptions = length(mylist()))
)
})
v <- reactiveValues()
observeEvent(input$show_plot, {
data <- data()
v$plot <- plot(x=data[,1], y=data[,2])
})
# If the user didn't choose to see the plot, it won't appear.
output$hist <- renderPlot({
req(data())
if (is.null(v$plot)) return()
if(input$show_plot > 0){
v$plot
}
})
}
Does anyone know how to help me, please?
Thanks very much
It's a little tricky.
First of all I'd update the selectizeInput on the server side as the warning suggests:
Warning: The select input "numbers" contains a large number of
options; consider using server-side selectize for massively improved
performance. See the Details section of the ?selectizeInput help
topic.
Furthermore I switched to ggplot2 regarding the plotOutput - Please see this related post.
To show the spinner while the selectizeInput is updating choices we'll need to know how long the update takes. This information can be gathered via shiny's JS events - please also see this article.
Finally, we can show the spinner for a non-existent output, so we are able to control for how long the spinner is shown (see uiOutput("dummyid")):
library(shiny)
library(shinycssloaders)
library(ggplot2)
ui <- fluidPage(
titlePanel("My app"),
tags$script(HTML(
"
$(document).on('shiny:inputchanged', function(event) {
if (event.target.id === 'numbers') {
Shiny.setInputValue('selectizeupdate', true, {priority: 'event'});
}
});
$(document).on('shiny:updateinput', function(event) {
if (event.target.id === 'numbers') {
Shiny.setInputValue('selectizeupdate', false, {priority: 'event'});
}
});
"
)),
sidebarLayout(
sidebarPanel(
tabsetPanel(
tabPanel("Submit",
checkboxInput("log2", "Log2 transformation", value = FALSE),
actionButton("submit", "Submit")
),
tabPanel("Selection",
br(),
selectizeInput(inputId = "numbers", label = "Choose one number:", choices=NULL),
actionButton("show_plot", "Show the plot")
))
),
mainPanel(
uiOutput("plotProxy")
)
)
)
server <- function(input, output, session) {
previousEvent <- reactiveVal(FALSE)
choicesReady <- reactiveVal(FALSE)
submittingData <- reactiveVal(FALSE)
observeEvent(input$selectizeupdate, {
if(previousEvent() && input$selectizeupdate){
choicesReady(TRUE)
submittingData(FALSE)
} else {
choicesReady(FALSE)
}
previousEvent(input$selectizeupdate)
})
data <- reactive({
data = read.csv("https://people.sc.fsu.edu/~jburkardt/data/csv/hw_25000.csv")
if(input$log2 == TRUE){
cols <- sapply(data, is.numeric)
data[cols] <- lapply(data[cols], function(x) log2(x+1))
}
return(data)
})
mylist <- reactive({
req(data()[,1])
})
observeEvent(input$submit, {
submittingData(TRUE)
reactivePlotObject(NULL) # reset
updateSelectizeInput(
session = session,
inputId = "numbers",
choices = mylist(), options=list(maxOptions = length(mylist())),
server = TRUE
)
})
reactivePlotObject <- reactiveVal(NULL)
observeEvent(input$show_plot, {
reactivePlotObject(ggplot(data(), aes_string(x = names(data())[1], y = names(data())[2])) + geom_point())
})
output$hist <- renderPlot({
reactivePlotObject()
})
output$plotProxy <- renderUI({
if(submittingData() && !choicesReady()){
withSpinner(uiOutput("dummyid"), type = 5, color = "#0dc5c1", size = 1)
} else {
conditionalPanel(condition = "input.show_plot > 0", withSpinner(plotOutput("hist"), type = 5, color = "#0dc5c1", size = 1), style = "display: none;")
}
})
}
shinyApp(ui, server)
First 100 rows of your example data (dput(head(data, 100)) - your link might be offline some day):
structure(list(Index = 1:100, Height.Inches. = c(65.78331, 71.51521,
69.39874, 68.2166, 67.78781, 68.69784, 69.80204, 70.01472, 67.90265,
66.78236, 66.48769, 67.62333, 68.30248, 67.11656, 68.27967, 71.0916,
66.461, 68.64927, 71.23033, 67.13118, 67.83379, 68.87881, 63.48115,
68.42187, 67.62804, 67.20864, 70.84235, 67.49434, 66.53401, 65.44098,
69.5233, 65.8132, 67.8163, 70.59505, 71.80484, 69.20613, 66.80368,
67.65893, 67.80701, 64.04535, 68.57463, 65.18357, 69.65814, 67.96731,
65.98088, 68.67249, 66.88088, 67.69868, 69.82117, 69.08817, 69.91479,
67.33182, 70.26939, 69.10344, 65.38356, 70.18447, 70.40617, 66.54376,
66.36418, 67.537, 66.50418, 68.99958, 68.30355, 67.01255, 70.80592,
68.21951, 69.05914, 67.73103, 67.21568, 67.36763, 65.27033, 70.84278,
69.92442, 64.28508, 68.2452, 66.35708, 68.36275, 65.4769, 69.71947,
67.72554, 68.63941, 66.78405, 70.05147, 66.27848, 69.20198, 69.13481,
67.36436, 70.09297, 70.1766, 68.22556, 68.12932, 70.24256, 71.48752,
69.20477, 70.06306, 70.55703, 66.28644, 63.42577, 66.76711, 68.88741
), Weight.Pounds. = c(112.9925, 136.4873, 153.0269, 142.3354,
144.2971, 123.3024, 141.4947, 136.4623, 112.3723, 120.6672, 127.4516,
114.143, 125.6107, 122.4618, 116.0866, 139.9975, 129.5023, 142.9733,
137.9025, 124.0449, 141.2807, 143.5392, 97.90191, 129.5027, 141.8501,
129.7244, 142.4235, 131.5502, 108.3324, 113.8922, 103.3016, 120.7536,
125.7886, 136.2225, 140.1015, 128.7487, 141.7994, 121.2319, 131.3478,
106.7115, 124.3598, 124.8591, 139.6711, 137.3696, 106.4499, 128.7639,
145.6837, 116.819, 143.6215, 134.9325, 147.0219, 126.3285, 125.4839,
115.7084, 123.4892, 147.8926, 155.8987, 128.0742, 119.3701, 133.8148,
128.7325, 137.5453, 129.7604, 128.824, 135.3165, 109.6113, 142.4684,
132.749, 103.5275, 124.7299, 129.3137, 134.0175, 140.3969, 102.8351,
128.5214, 120.2991, 138.6036, 132.9574, 115.6233, 122.524, 134.6254,
121.8986, 155.3767, 128.9418, 129.1013, 139.4733, 140.8901, 131.5916,
121.1232, 131.5127, 136.5479, 141.4896, 140.6104, 112.1413, 133.457,
131.8001, 120.0285, 123.0972, 128.1432, 115.4759)), row.names = c(NA,
100L), class = "data.frame")
The app below contains a selectInput of dataset IDs and a button View details which displays a modalDialog when clicked. The modal dialog has a datatable that contains some information about the datasets in the selectInput dropdown.
Here is a screenshot of the app on startup:
Since the user can select a dataset either by selecting an option from the dropdown menu or by selecting a row in the datatable, I created a reactive value rv$selectedRow which stores the value of the selected dataset. When the modal is triggered, rv$selectedRow takes the value of input$data. When the Select button in the modal footer is clicked, rv$selectedRow takes the value of input$dfs_rows_selected and the selectInput is updated to reflect this new value. This is done by the two observeEvents in the code below.
When the user selects a row, closes the modal and opens it again, I would like the page and row of the selected dataset (input$data) to be pre-selected. I tried to achieve this using selection = list(mode = 'single', selected = rv$selectedRow) in the renderDT call. As you can see in the screenshot, row 1 should be pre-selected but it isn't. I feel like I'm missing a req() somewhere in the renderDT but I'm not sure. The value of rv$selectedRow checks out when I print it to the console, so I don't know why the selected argument of renderDT isn't working. I am also not sure how to store the page of the selected row. Any insight would be much much appreciated as I'm a little lost.
The app is as follows:
library(shiny)
library(DT)
datasets = data.frame(cbind(id = seq_len(4), name = c('iris', 'mtcars', 'satellite', 'credit')))
# UI ----------------------------------------------------------------------
ui = fluidPage(
selectInput('data', 'Select dataset:', choices = datasets$id),
actionButton('view', 'View details')
)
# SERVER ------------------------------------------------------------------
server <- shinyServer(function(input, output, session) {
rv = reactiveValues(selectedRow = NULL, selectedPage = NULL)
# Opening the modal
observeEvent(input$view, {
rv$selectedRow = req(input$data)
print(paste("selectedRow on 'View':", rv$selectedRow))
showModal(modalDialog(
title = 'Available datasets',
tags$b('Click on a row to select a dataset.'),
br(),
br(),
DT::dataTableOutput('dfs'),
easyClose = F,
footer = tagList(
modalButton('Cancel'),
bsButton('select', 'Select')
)
)
)
})
# Rendering the DT - pre-selection of row not working
output$dfs <- renderDT({
print(paste("selectedRow on 'renderDT':", rv$selectedRow))
datasets
},
options = list(
# displayStart = selectedPage,
pageLength = 2
),
filter = 'top',
selection = list(mode = 'single', selected = rv$selectedRow),
rownames = F
)
# Saving the selected row and updating the selectInput
observeEvent(input$select, {
rv$selectedRow = req(input$dfs_rows_selected)
print(paste("selectedRow on 'Select':", rv$selectedRow))
updateSelectInput(session = session, inputId = 'data', selected = datasets[rv$selectedRow, 1])
removeModal(session)
})
})
shinyApp(ui, server)
Updated code:
As per this solution and the one posted by Wilmar below, using datatable() in the renderDT seemed to fix the problem -
library(shiny)
library(DT)
datasets = data.frame(cbind(id = seq_len(4), name = c('iris', 'mtcars', 'satellite', 'credit')))
# UI ----------------------------------------------------------------------
ui = fluidPage(
selectInput('data', 'Select dataset:', choices = datasets$id),
actionButton('view', 'View details')
)
# SERVER ------------------------------------------------------------------
server <- shinyServer(function(input, output, session) {
rv = reactiveValues(selectedRow = NULL, selectedPage = NULL)
# Opening the modal
observeEvent(input$view, {
print(paste("selectedRow on 'View':", rv$selectedRow))
showModal(modalDialog(
title = 'Available datasets',
tags$b('Click on a row to select a dataset.'),
br(),
br(),
DT::dataTableOutput('dfs'),
easyClose = F,
footer = tagList(
modalButton('Cancel'),
bsButton('select', 'Select')
)
)
)
})
# Rendering the DT - pre-selection of row not working
output$dfs <- renderDataTable({
r = rv$selectedRow
print(paste("selectedRow on 'renderDT':", r))
datatable(
datasets,
options = list(
displayStart = as.numeric(r)-1,
pageLength = 2
),
filter = 'top',
selection = list(mode = 'single', selected = r),
rownames = F
)
}, server = F)
# Saving the selected row and updating the selectInput
observeEvent(input$select, {
rv$selectedRow = req(input$dfs_rows_selected)
print(paste("selectedRow on 'Select':", rv$selectedRow))
updateSelectInput(session = session, inputId = 'data', selected = datasets[rv$selectedRow, 1])
removeModal(session)
})
observe({
rv$selectedRow = input$data
})
})
shinyApp(ui, server)
I guess this is what you're looking for. Your first problem was that you had to convert rv$selectedRow to numeric. Secondly it you were re-rendering your datatable everytime you pressed the "view" button. And thirdly you didn't do anything with your selectInput ("data").
I transformed rv$selectedRow to a numeric, moved your showModal to the ui and created an observer for your selectInput. In addition, I wrapped your datafarme in the datatable function, which I think is a bit more convenient.
Working example:
library(shiny)
library(DT)
library(shinyBS)
datasets = data.frame(cbind(id = seq_len(4), name = c('iris', 'mtcars', 'satellite', 'credit')))
# UI ----------------------------------------------------------------------
ui = fluidPage(
selectInput('data', 'Select dataset:', choices = datasets$id),
actionButton('view', 'View details'),
tags$head(tags$style("#df_popup .modal-footer{ display:none}
#df_popup .modal-header .close{display:none}")),
bsModal("df_popup", title='Available datasets', trigger='view',
tags$b('Click on a row to select a dataset.'),
br(),
br(),
DT::dataTableOutput('dfs'),
column(12, align='right',
modalButton('Cancel'),
bsButton('select', 'Select')
)
)
)
# SERVER ------------------------------------------------------------------
server <- shinyServer(function(input, output, session) {
rv = reactiveValues(selectedRow = NULL, selectedPage = NULL)
# Rendering the DT - pre-selection of row not working
output$dfs <- renderDT({
print(paste("selectedRow on 'renderDT':", rv$selectedRow))
datatable(datasets, options = list(
# displayStart = selectedPage,
pageLength = 2
),
filter = 'top',
selection = list(mode = 'single', selected=c(as.numeric(rv$selectedRow))),
rownames = F)
},
)
# Saving the selected row and updating the selectInput
observeEvent(input$select, {
rv$selectedRow = req(input$dfs_rows_selected)
print(paste("selectedRow on 'Select':", rv$selectedRow))
updateSelectInput(session = session, inputId = 'data', selected = datasets[rv$selectedRow, 1])
toggleModal(session, 'df_popup')
})
observeEvent(input$data, {
rv$selectedRow = input$data
print(paste("selectedRow on 'data':", rv$selectedRow))
})
})
shinyApp(ui, server)
I have a very simple question:
Why is it in the following code not possible to remove the last entered value in SelectizeInput? E.g. I entered "a" "b" & "c" and I want to delete them all afterwards from the SelectizeInput. Why is it no possible to remove the last remaing value from SelectizeInput?
library(shiny)
ui <- bootstrapPage(
textInput(inputId = "txtinput", label = "Insert label", value = "", placeholder = ""),
actionButton(inputId = "actbtn", label = "Add label"),
uiOutput('selctInput')
)
server <- function(input, output, session){
#Create reactive values
rv <- reactiveValues()
#When Button is clicked..
observeEvent(input$actbtn, {
#Save value in a reactiveValues list
rv$new.label <- input$txtinput
#Collect all entries from text input
rv$labels <- c(rv$labels, rv$new.label)
#Clear textinput
updateTextInput(session, "txtinput", value = "")
})
#When selectizeInput changes...
observeEvent(input$selctInput, {
#Why is it not possible to completely empty selectizeInput? The last value just remains.
rv$labels <- input$selctInput
print(input$selctInput)
})
#Add selectizeInput to UI
output$selctInput <- renderUI({
selectizeInput(inputId = "selctInput", label= "Reorder / delete labels",
choices = rv$labels,
selected = rv$labels, multiple=TRUE,
options = list(plugins = list('remove_button', 'drag_drop')))
})
}
shinyApp(ui, server)
You just need to add ignoreNULL = FALSE to your observeEvent so that it "reacts" to the NULL value
#When selectizeInput changes...
observeEvent(input$selctInput, {
#Why is it not possible to completely empty selectizeInput? The last value just remains.
rv$labels <- input$selctInput
print(input$selctInput)
}, ignoreNULL = FALSE)
Update:
After finding this link https://gist.github.com/pvictor/ee154cc600e82f3ed2ce0a333bc7d015 there seems to be a far simpler approach:
library(shiny)
ui <- fluidPage(
selectizeInput("select", "Select", c(),
multiple = TRUE, options = list(
'plugins' = list('remove_button'),
'create' = TRUE,
'persist' = FALSE)
),
textOutput("out")
)
server <- function(input, output){
output$out <- renderText({
input$select
})
}
shinyApp(ui, server)
I am new to the shiny, I would like to edit different multiple data frames by radio button or selectinput by using rhandsontable package. However, my script can not show other data frame but only the first one, I don't know what is the problem.
ui.R:
library(rhandsontable)
fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("select2", label = h3("Choose to edit"),
choices = list("003.csv", "004.csv", "005.csv",
"006.csv", "007.csv"),
selected = "003.csv"),
actionButton("saveBtn", "Save changes")
),
mainPanel(
rHandsontableOutput("hot")
)))
server.R
values <- reactiveValues()
setHot <- function(x) values[["hot"]] <<- x
function(input, output, session) {
fname <- reactive({
x <- input$select2
return(x)
})
observe({
input$saveBtn # update csv file each time the button is pressed
if (!is.null(values[["hot"]])) {
write.csv(x = values[["hot"]], file = fname(), row.names = FALSE)
}
})
output$hot <- renderRHandsontable({
if (!is.null(input$hot)) { # if there is an rhot user input...
DF <- hot_to_r(input$hot) # convert rhandsontable data to R object
and store in data frame
setHot(DF) # set the rhandsontable values
} else {
DF <- read.csv(fname(), stringsAsFactors = FALSE) # else pull table from the csv (default)
setHot(DF) # set the rhandsontable values
}
rhandsontable(DF) %>% # actual rhandsontable object
hot_table(highlightCol = TRUE, highlightRow = TRUE, readOnly = TRUE) %>%
hot_col("Status", readOnly = FALSE)
})}
I can edit and save the dataframe that it shows the first one 003.csv, however when i use the drop down list to 004.csv, it didn't show the dataframe. please advise.
This will write (and possibly overwrite ⚠ any existing file with) dummy data:
for (i in c("003.csv", "004.csv", "005.csv", "006.csv", "007.csv")) {
write.csv(cbind(V1 = rep(i, 3), Status = "foo"), i, row.names = FALSE)
}
I overhauled server a bit:
library(shiny)
library(rhandsontable)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput(
"select2", label = h3("Choose to edit"), selected = "003.csv",
choices = list("003.csv", "004.csv", "005.csv", "006.csv", "007.csv")
),
actionButton("saveBtn", "Save changes")
),
mainPanel(
rHandsontableOutput("hot")
)
)
)
server <- function(input, output, session) {
DF <- reactiveVal()
observe({
DF(read.csv(input$select2, stringsAsFactors = FALSE))
})
observe({
if (!is.null(input$hot)) DF(hot_to_r(input$hot))
})
observeEvent(input$saveBtn, {
if (!is.null(DF())) write.csv(DF(), input$select2, row.names = FALSE)
})
output$hot <- renderRHandsontable({
rhandsontable(DF()) %>%
hot_table(highlightCol = TRUE, highlightRow = TRUE, readOnly = TRUE) %>%
hot_col("Status", readOnly = FALSE)
})
}
shinyApp(ui, server)