我希望 R 中闪亮的应用程序读取 Excel 文件,添加空行,用户可以在其中添加文本输入,单击按钮后,它会使用添加的输入更新表格,并且表格顶部的一行将再次为空,等待用户输入。我已经成功地让它第一次工作,例如我可以添加输入,单击按钮,表格就会更新,第一行正在等待另一个输入。但是,当我再次添加新输入时,该表将使用我第一次输入的相同文本进行更新。 问题似乎出在我更新observeEvent()内的reactiveValues的行中的某个地方,因为当我删除该行时,打印语句会打印正确的输入。当我保留该行时,始终只打印第一个输入。
非常感谢您的帮助!
library(shiny)
library(plyr)
library(dplyr)
library(DT)
library(xlsx)
library(lubridate)
ui <- fluidPage(fluidRow(column(4, offset = 0, actionButton("add_button", "Add", width = 200))),
br(),
DT::dataTableOutput("outtable")
)
server <- function(input, output) {
excel_file <- data.frame(Month = c("2024-01", "2023-12"),
Date = c("2024-01-10", "2023-12-15"),
Reviewer = c("A", "B"),
Status = c("OK", "OK"),
Comment = c("bla", "blabla"), stringsAsFactors = FALSE)
excel_file <- excel_file %>%
arrange(desc(Month))
df_input <- data.frame(
Month = as.character(format(ym(max(excel_file$Month)) %m+% months(1), "%Y-%m")),
Date = as.character(textInput("date", label = NULL)),
Reviewer = as.character(textInput("reviewer", label = NULL)),
Status = as.character(textInput("status", label = NULL)),
Comment = as.character(textInput("comment", label = NULL)))
RV <- reactiveValues(dat = bind_rows(df_input, excel_file))
observeEvent(
eventExpr = c(input$add_button),
handlerExpr = {
new_line <- data.frame(
Month = as.character(format(ym(max(RV$dat$Month)), "%Y-%m")),
Date = input$date,
Reviewer = input$reviewer,
Status = input$status,
Comment = input$comment)
print(new_line)
temp <- bind_rows(RV$dat, new_line) %>%
arrange(desc(Month))
RV$dat <- temp # THIS LINE
},ignoreNULL = FALSE , ignoreInit = TRUE
)
output$outtable <- DT::renderDataTable({
datatable(
RV$dat,
selection="none",
escape = FALSE,
options = list(
dom = 'rtpi',
autoWidth=TRUE,
preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
)
)
})
}
shinyApp(ui = ui, server = server)
您正在
datatable
中使用反应式数据框来更新表格。当它发生变化时,表格将被重新绘制,并且闪亮的解除绑定/绑定将丢失。相反,人们可以将 replaceData
与代理一起使用。
library(shiny)
library(plyr)
library(dplyr)
library(DT)
library(lubridate)
excel_file <- data.frame(
Month = c("2024-01", "2023-12"),
Date = c("2024-01-10", "2023-12-15"),
Reviewer = c("A", "B"),
Status = c("OK", "OK"),
Comment = c("bla", "blabla"),
stringsAsFactors = FALSE
)
excel_file <- excel_file %>% arrange(desc(Month))
df_input <- data.frame(
Month = as.character(format(ym(max(excel_file$Month)) %m+% months(1), "%Y-%m")),
Date = as.character(textInput("date", label = NULL)),
Reviewer = as.character(textInput("reviewer", label = NULL)),
Status = as.character(textInput("status", label = NULL)),
Comment = as.character(textInput("comment", label = NULL))
)
dat <- bind_rows(df_input, excel_file)
ui <- fluidPage(
fluidRow(
column(
4,
offset = 0,
actionButton("add_button", "Add", width = 200)
)
),
br(),
DTOutput("outtable")
)
server <- function(input, output, session) {
Dat <- reactiveVal(dat)
output$outtable <- renderDT({
datatable(
dat,
selection = "none",
escape = FALSE,
options = list(
dom = 'rtpi',
autoWidth = TRUE,
preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
)
)
})
proxy <- dataTableProxy("outtable")
observeEvent(
eventExpr = input$add_button,
handlerExpr = {
dat0 <- Dat()
new_line <- data.frame(
Month = as.character(format(ym(max(dat0$Month)), "%Y-%m")),
Date = input$date,
Reviewer = input$reviewer,
Status = input$status,
Comment = input$comment
)
dat1 <- bind_rows(dat0, new_line) %>% arrange(desc(Month))
Dat(dat1)
replaceData(proxy, dat1, resetPaging = FALSE)
}, ignoreInit = TRUE
)
}
shinyApp(ui = ui, server = server)