为 renderDataTable() 隔离（）数据，然后使用 DataTableProxy 编辑表 - 我做错了什么？

问题描述 投票：0回答：1

我想构建一个闪亮的应用程序，为用户提供一个选择器（用于子集数据）、一个数据表（用于显示数据）和一组按钮，可用于标记数据表中当前选定的行（请参阅代表如下）。重要的是，数据表应该是隔离的（即，当底层数据被修改时，它不应该更新和重新渲染），以避免重置过滤器/排序/页面或由于重新加载而闪烁。但是，我认为我错误地使用了isolate()或DataTableProxy()（参见下面的示例）。最终我想保存编辑后的数据，这是另一个故事，但我什至很难让它正确显示：

在下面的示例中，我实现了我的预期，除了 DataTable 不是隔离的，并且当我选择一行并按下“Seen X times”按钮时会重新呈现。

library(shiny)
library(shinydashboard)
library(shinyjs)
library(dplyr)
library(DT)
library(stringr)
library(data.table)

test_data <- mtcars
test_data$manufacturer <- str_split_fixed(rownames(test_data), " ", 2)[,1]
test_data$model <- str_split_fixed(rownames(test_data), " ", 2)[,2]
test_data$seen <- ""

ui <- dashboardPage(
  dashboardHeader(title = "mtcars seen x times", titleWidth = 450),
  dashboardSidebar(width = 300, 
                   sidebarMenu(
                     id = "menu1",
                     menuItem("Cars", tabName = "Cars"),
                     selectInput("selData","Manufacturer",choices = test_data$manufacturer)
                   )
  ),
  dashboardBody(
    useShinyjs(),
    tabItems(
      tabItem(
        tabName = "Cars",
        fluidRow(
          box(title = "details", 
              width = 12, style='overflow-y:scroll; height:80vh;',
              
              # create array of buttons
              actionButton("seen_1","Seen 1x"),
              actionButton("seen_2","Seen 2x"),
              actionButton("seen_3","Seen 3x"),
              actionButton("seen_4","Seen 4x"),
              actionButton("seen_5","Seen 5x"),
              DT::dataTableOutput("details"))
        )
      )
    )
  )
)


server <- function(input, output, session) {
  
  test_data_current <- reactiveVal()
  test_data_selection <- reactiveVal()
  
  observeEvent(input$selData, {
    test_data_current(test_data[test_data$manufacturer == input$selData,])
    test_data_selection(test_data[test_data$manufacturer == input$selData, c("manufacturer","model","mpg","disp","hp","seen")])
  })
  
  output$details <- DT::renderDataTable({
    input$selData
    DT::datatable(test_data_selection(), 
                  rownames = F,
                  selection = "single")
  })
  
  # update data based on which button was pressed
  proxy = dataTableProxy("details")
  lapply(1:5, function(i){
    selector <- paste0("seen_",i)
    observeEvent(input[[selector]], {
      req(input$details_rows_selected)
      info <- data.frame("row" = input$details_rows_selected,
                         "col" = which(colnames(test_data_selection()) == "seen"),
                         value = recode(i, "1" = "1x", "2" = "2x", "3" = "3x", "4" = "4x", "5" = "5x"))
      edit_data <<- editData(test_data_selection(), info, proxy)
      test_data_selection(edit_data)
    })
  })
  
  
  
}


shinyApp(ui = ui, server = server)

在调整后的示例中，我使用isolate()中包含的数据调用renderDataTable。

library(shiny)
library(shinydashboard)
library(shinyjs)
library(dplyr)
library(DT)
library(stringr)
library(data.table)

test_data <- mtcars
test_data$manufacturer <- str_split_fixed(rownames(test_data), " ", 2)[,1]
test_data$model <- str_split_fixed(rownames(test_data), " ", 2)[,2]
test_data$seen <- ""

ui <- dashboardPage(
  dashboardHeader(title = "mtcars seen x times", titleWidth = 450),
  dashboardSidebar(width = 300, 
                   sidebarMenu(
                     id = "menu1",
                     menuItem("Cars", tabName = "Cars"),
                     selectInput("selData","Manufacturer",choices = test_data$manufacturer)
                   )
  ),
  dashboardBody(
    useShinyjs(),
    tabItems(
      tabItem(
        tabName = "Cars",
        fluidRow(
          box(title = "details", 
              width = 12, style='overflow-y:scroll; height:80vh;',
              
              # create array of buttons
              actionButton("seen_1","Seen 1x"),
              actionButton("seen_2","Seen 2x"),
              actionButton("seen_3","Seen 3x"),
              actionButton("seen_4","Seen 4x"),
              actionButton("seen_5","Seen 5x"),
              DT::dataTableOutput("details"))
        )
      )
    )
  )
)


server <- function(input, output, session) {
  
  test_data_current <- reactiveVal()
  test_data_selection <- reactiveVal()
  
  observeEvent(input$selData, {
    test_data_current(test_data[test_data$manufacturer == input$selData,])
    test_data_selection(test_data[test_data$manufacturer == input$selData, c("manufacturer","model","mpg","disp","hp","seen")])
  })
  
  output$details <- DT::renderDataTable({
    input$selData
    DT::datatable(isolate(test_data_selection()), 
                  rownames = F,
                  selection = "single")
  })
  
  # update data based on which button was pressed
  proxy = dataTableProxy("details")
  lapply(1:5, function(i){
    selector <- paste0("seen_",i)
    observeEvent(input[[selector]], {
      req(input$details_rows_selected)
      info <- data.frame("row" = input$details_rows_selected,
                         "col" = which(colnames(test_data_selection()) == "seen"),
                         value = recode(i, "1" = "1x", "2" = "2x", "3" = "3x", "4" = "4x", "5" = "5x"))
      edit_data <<- editData(test_data_selection(), info, proxy)
      test_data_selection(edit_data)
    })
  })
  
  
  
}


shinyApp(ui = ui, server = server)

但是，这会导致意外的行为：如果我按下按钮，所有行都会消失，直到我更改 input$selData。我怀疑我使用的isolate 或DataTableProxy 是错误的，但我似乎无法弄清楚。我真的很感谢任何帮助。

r shiny datatable proxy isolate
1个回答
0
投票

答案：在此设置中，使用 rownames = F 调用 datatable() 会导致所描述的意外行为。以下代码按预期执行：

library(shiny)
library(shinydashboard)
library(shinyjs)
library(dplyr)
library(DT)
library(stringr)
library(data.table)

test_data <- mtcars
test_data$manufacturer <- str_split_fixed(rownames(test_data), " ", 2)[,1]
test_data$model <- str_split_fixed(rownames(test_data), " ", 2)[,2]
test_data$seen <- ""

ui <- dashboardPage(
  dashboardHeader(title = "mtcars seen x times", titleWidth = 450),
  dashboardSidebar(width = 300, 
                   sidebarMenu(
                     id = "menu1",
                     menuItem("Cars", tabName = "Cars"),
                     selectInput("selData","Manufacturer",choices = test_data$manufacturer)
                   )
  ),
  dashboardBody(
    useShinyjs(),
    tabItems(
      tabItem(
        tabName = "Cars",
        fluidRow(
          box(title = "details", 
              width = 12, style='overflow-y:scroll; height:80vh;',
              
              # create array of buttons
              actionButton("seen_1","Seen 1x"),
              actionButton("seen_2","Seen 2x"),
              actionButton("seen_3","Seen 3x"),
              actionButton("seen_4","Seen 4x"),
              actionButton("seen_5","Seen 5x"),
              DT::dataTableOutput("details"))
        )
      )
    )
  )
)


server <- function(input, output, session) {
  
  test_data_current <- reactiveVal()
  test_data_selection <- reactiveVal()
  
  observeEvent(input$selData, {
    test_data_current(test_data[test_data$manufacturer == input$selData,])
    test_data_selection(test_data[test_data$manufacturer == input$selData, c("manufacturer","model","mpg","disp","hp","seen")])
  })
  
  output$details <- DT::renderDataTable({
    input$selData
    DT::datatable(isolate(test_data_selection()),
                  selection = "single")
  })
  
  # update data based on which button was pressed
  proxy = dataTableProxy("details")
  lapply(1:5, function(i){
    selector <- paste0("seen_",i)
    observeEvent(input[[selector]], {
      req(input$details_rows_selected)
      info <- data.frame("row" = input$details_rows_selected,
                         "col" = which(colnames(test_data_selection()) == "seen"),
                         value = recode(i, "1" = "1x", "2" = "2x", "3" = "3x", "4" = "4x", "5" = "5x"))
      edit_data <<- editData(test_data_selection(), info, proxy)
      test_data_selection(edit_data)
    })
  })
  
  
  
}


shinyApp(ui = ui, server = server)
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.