问题描述
我设计了一个带有 Shiny
的 DT
应用,它可以检测输入字段是否发生变化并自动更新值。下面是一个屏幕截图和我的代码。这个应用程序按我的预期工作。运行此应用时,DT
中的值会根据输入值进行相应更新。
# Load the packages
library(tidyverse)
library(shiny)
library(DT)
# Create an empty data frame
dat <- tibble(
Input = c("SliderInput","RadioButtons","TextInput"),Value = NA_character_
)
ui <- fluidPage(
titlePanel("DT: Document the Input Values"),sidebarLayout(
sidebarPanel = sidebarPanel(
# The input widgets
sliderInput(inputId = "Slider",label = "The SliderInput",min = 1,max = 10,value = 5),br(),radioButtons(inputId = "Radio",label = "The RadioButtons",choices = c("A","B","C")),textInput(inputId = "Text",label = "The TextInput",value = "Enter text ...")
),mainPanel = mainPanel(
# The datatable
DTOutput(outputId = "d1")
)
)
)
server <- function(input,output,session){
# Save the dat to a reactive object
dat_save <- reactiveValues(df = dat)
output$d1 <- renderDT(dat,options = list(pageLength = 5),editable = TRUE,rownames = TRUE)
# Save the condition of the data table d1
d1_proxy <- dataTableProxy("d1")
# Edit the data table
observeEvent(input$d1_cell_edit,{
dat_save$df <- editData(dat_save$df,input$d1_cell_edit,d1_proxy)
})
# Update the input numbers for each cell
observeEvent(input$Slider,{
dat_save$df[1,"Value"] <- as.character(input$Slider)
})
observeEvent(input$Radio,{
dat_save$df[2,"Value"] <- input$Radio
})
observeEvent(input$Text,{
dat_save$df[3,"Value"] <- input$Text
})
observe({
replaceData(d1_proxy,dat_save$df,resetPaging = FALSE)
})
}
shinyApp(ui,server)
但是,当我将相同的代码转移到具有多个标签的 shinydahsboard
时。首次初始化应用程序时,DT
无法更新值。下面是截图和代码。
# Load the packages
library(tidyverse)
library(shiny)
library(shinydashboard)
library(DT)
# Create an empty data frame
dat <- tibble(
Input = c("SliderInput",Value = NA_character_
)
ui <- function(request) {
dashboardPage(
# The header panel
header = dashboardHeader(title = ""),# The sidebar panel
sidebar = dashboardSidebar(
# The sidebar manual
sidebarMenu(
id = "tabs",# Tab 1
menuItem(
text = "Tab1",tabName = "Tab1"
),# Tab 2
menuItem(
text = "DT Example",tabName = "DT_E"
)
)),# The main panel
body = dashboardBody(
tabItems(
tabItem(
# The tab name
tabName = "Tab1",h2("Placeholder")
),# Tab 2: DT example
tabItem(
# The tab name
tabName = "DT_E",h2("DT: Document the Input Values"),sidebarPanel(
# The input widgets
sliderInput(inputId = "Slider",value = "Enter text ...")
),# The datatable
DTOutput(outputId = "d1")
)
)
)
)
}
server <- function(input,server)
请注意,如果 shinydashboard
中只有一个选项卡,DT
将起作用。如果在初始化应用程序后更改了任何输入值,DT
也将起作用。但是,当 DT
有多个选项卡时,为什么 shinydashboard
一开始就不能工作对我来说是个谜。任何建议或意见都会很棒。
解决方法
进一步搜索后,我从这个 post 和这个 post 中找到了解决方案。由于某些原因,shinydashboard
的默认设置是忽略从第二个选项卡开始的隐藏对象。就我而言,添加 outputOptions(output,"d1",suspendWhenHidden = FALSE)
可以解决问题。完整代码如下。
# Load the packages
library(tidyverse)
library(shiny)
library(shinydashboard)
library(DT)
# Create an empty data frame
dat <- tibble(
Input = c("SliderInput","RadioButtons","TextInput"),Value = NA_character_
)
ui <- function(request) {
dashboardPage(
# The header panel
header = dashboardHeader(title = ""),# The sidebar panel
sidebar = dashboardSidebar(
# The sidebar manual
sidebarMenu(
id = "tabs",# Tab 1
menuItem(
text = "Tab1",tabName = "Tab1"
),# Tab 2
menuItem(
text = "DT Example",tabName = "DT_E"
)
)),# The main panel
body = dashboardBody(
tabItems(
tabItem(
# The tab name
tabName = "Tab1",h2("Placeholder")
),# Tab 2: DT example
tabItem(
# The tab name
tabName = "DT_E",h2("DT: Document the Input Values"),sidebarPanel(
# The input widgets
sliderInput(inputId = "Slider",label = "The SliderInput",min = 1,max = 10,value = 5),br(),radioButtons(inputId = "Radio",label = "The RadioButtons",choices = c("A","B","C")),textInput(inputId = "Text",label = "The TextInput",value = "Enter text ...")
),# The datatable
DTOutput(outputId = "d1")
)
)
)
)
}
server <- function(input,output,session){
# Save the dat to a reactive object
dat_save <- reactiveValues(df = dat)
output$d1 <- renderDT(dat,options = list(pageLength = 5),editable = TRUE,rownames = TRUE)
outputOptions(output,suspendWhenHidden = FALSE)
# Save the condition of the data table d1
d1_proxy <- dataTableProxy("d1")
# Edit the data table in tab 3
observeEvent(input$d1_cell_edit,{
dat_save$df <- editData(dat_save$df,input$d1_cell_edit,d1_proxy)
})
# Update the input numbers for each cell
observeEvent(input$Slider,{
dat_save$df[1,"Value"] <- as.character(input$Slider)
})
observeEvent(input$Radio,{
dat_save$df[2,"Value"] <- input$Radio
})
observeEvent(input$Text,{
dat_save$df[3,"Value"] <- input$Text
})
observe({
replaceData(d1_proxy,dat_save$df,resetPaging = FALSE)
})
}
shinyApp(ui,server)