我正在运行两个可扩展的rhandsontables,它们应该始终具有相同的列数和相同的列标题,但行不同。其中一个表(myDF1呈现在"hottable1"中)是主表,用户在其中向包含该表和第二个表的tabPanel()
添加/删除列(myDF2呈现在"hottable2"中)在列数和列标题方面模仿第一个表,但被放置在单独的tabPanel()
中,对第一个tabPanel()
中的操作按钮做出React。奇怪的是,当两个表在Shiny的fluidPage()
中呈现时,或者当使用Shiny的pageWithSidebar()
时,这两个表位于同一个tabPanel()
中时,这种链接列的添加/删除工作正常。(如下面的代码所示),列添加工作正常,但从选项卡"主"删除列时,选项卡"从"中的第二个表崩溃。
我一定错过了一些关于tabPanels()
的非常基本的东西。我做错了什么?
我总是假设React性贯穿tabPanels()
。
代码:
library(dplyr)
library(rhandsontable)
library(shiny)
myDF1 <- data.frame('Series 1' = c(1,24,0), check.names = FALSE)
rownames(myDF1) <- c('Term A','Term B','Term C')
myDF2 <- data.frame('Series 1' = c(20,15), check.names = FALSE)
rownames(myDF2) <- c('Boy','Girl')
ui <- pageWithSidebar(
headerPanel(""),sidebarPanel(""),
mainPanel(
tabsetPanel(
tabPanel("Master table", hr(),
rHandsontableOutput('hottable1'),br(),
actionButton("addSeries", "Add", width = 80),
fluidRow(
column(2,actionButton("delSeries","Delete", width = 80)),
column(3,uiOutput("delSeries2"))
),
),
tabPanel("Slave table", hr(),rHandsontableOutput('hottable2'))
)
)
)
server <- function(input, output) {
emptyTbl1 <- reactiveVal(myDF1)
emptyTbl2 <- reactiveVal(myDF2)
observeEvent(input$hottable1, {emptyTbl1(hot_to_r(input$hottable1))})
observeEvent(input$hottable2, {emptyTbl2(hot_to_r(input$hottable2))})
output$hottable1 <- renderRHandsontable({
rhandsontable(emptyTbl1(),rowHeaderWidth = 100, useTypes = TRUE)%>%
hot_context_menu(allowRowEdit = FALSE, allowColEdit = FALSE)
})
output$hottable2 <- renderRHandsontable({
rhandsontable(emptyTbl2(),rowHeaderWidth = 100, useTypes = TRUE)%>%
hot_context_menu(allowRowEdit = FALSE, allowColEdit = FALSE)
})
observeEvent(input$addSeries, {
newCol1 <- data.frame(c(1,24,0))
newCol2 <- data.frame(c(20,15))
names(newCol1) <- paste("Series", ncol(hot_to_r(input$hottable1)) + 1)
names(newCol2) <- paste("Series", ncol(hot_to_r(input$hottable2)) + 1)
emptyTbl1(cbind(emptyTbl1(), newCol1))
emptyTbl2(cbind(emptyTbl2(), newCol2))
})
observeEvent(input$delSeries3, {
tmp1 <- emptyTbl1()
tmp2 <- emptyTbl2()
if(ncol(tmp1) > 1){
delCol <- input$delSeries3
tmp1 <- tmp1[ , !(names(tmp1) %in% delCol), drop = FALSE]
tmp2 <- tmp2[ , !(names(tmp2) %in% delCol), drop = FALSE]
newNames <- sprintf("Series %d",seq(1:ncol(tmp1)))
names(tmp1) <- newNames
names(tmp2) <- newNames
emptyTbl1(tmp1)
emptyTbl2(tmp2)
}
})
output$delSeries2 <-
renderUI(
selectInput("delSeries3",
label = NULL,
choices = colnames(hot_to_r(input$hottable1)),
selected = "", width = '100px',
multiple = TRUE)
)
}
shinyApp(ui,server)
1条答案
按热度按时间v8wbuo2f1#
以下“已解决代码”解决了该问题。OP代码的一些变更在下面进行了注解,总结如下:
1.在
server()
节中插入outputOptions(output, 'hottable2', suspendWhenHidden = FALSE)
,以便更新位于单独选项卡面板中的第2个表,而操作按钮从另一个选项卡面板驱动该表;允许React性立即跨越未被查看的选项卡面板1.即使有了上面的修正,“hottable 2”表也必须点击才能完全渲染。R whiz Stéphane Laurent指出,当以这种方式重新渲染时,Shiny中存在一个已知的bug,他的html解决方案相应地包含在下面
server()
部分中用于“hottable 2”的rhandsontable()
函数的修订代码中并进行了注解解析代码: