单击数据 table 上的任何按钮时更改选项卡

Change tabs when any button on data table is clicked

我正在尝试调整以下代码以在单击数据 table 上的任何按钮时更改选项卡。错误消息说缺少按钮参数,我找不到。我的最终目标是使用这些按钮来过滤相关数据并显示在另一个选项卡中。请看一下。谢谢你的时间。

library(shiny)
library(ggplot2)
library(DT)
library(DBI)
library(shinyjs)
library(shinydashboard)
library(data.table)
library(pool)
library(dplyr)
library(shinyWidgets)


ui <- fluidPage(
    title = "Examples of DataTables",
    tabsetPanel(
        id = 'dataset',
        tabPanel("tab 1", DT::dataTableOutput("tab1"), verbatimTextOutput('printMsg')),
        tabPanel("tab 2", DT::dataTableOutput("tab2")),
        tabPanel("tab 2", DT::dataTableOutput("tab3"))
    )
    
)

server <- function(input, output) {
    
    printText <- reactiveValues(run_id = '')
    
    buttonInput <- function(FUN, len, id, ...) {
        inputs <- character(len)
        for (i in seq_len(len)) {
            inputs[i] <- as.character(FUN(paste0(id, i), ...))
        }
        inputs
    }
    
    vals <- reactiveValues()
    
    #vals$Data <- data.table(
    vals$Data <- data.table(
        
        Brands = paste0("Brand", 1:10),
        Forecasted_Growth = sample(1:20, 10),
        Last_Year_Purchase = round(rnorm(10, 1000, 1000) ^ 2),
        Contact = paste0("Brand", 1:10, "@email.com"),
        
        'Lane Summary' = buttonInput(
            FUN = actionButton,
            len = 10,
            id = 'button_',
            label = "+",
            onclick = 'Shiny.onInputChange(\"lastClick\",  this.id)'
        )
    )
    
    
    output$tab1 <- DT::renderDataTable({
        DT = vals$Data
        datatable(DT, escape = F)
    })
    
    observeEvent(input$lastClick, {
        selectedRow <- as.numeric(strsplit(input$lastClick, "_")[[1]][2])
        printText$run_id <<- paste('clicked on ',vals$Data[selectedRow,1])
        #change tabs
        updateTabsetPanel(session, "dataset",
                          selected = "tab 2")
        
    })
    
    output$printMsg <- renderText({
        printText$run_id
    })
    
}

shinyApp(ui, server)

您需要将 session 作为参数包含在 server 函数中,然后它才能工作。由于遗留原因,session 的使用不是强制性的,但现在建议使用。在您的情况下,您需要它,因为 updateTabsetPanel 使用 session 对象:

library(shiny)
library(ggplot2)
library(DT)
library(shinyjs)
library(shinydashboard)
library(data.table)
library(dplyr)
library(shinyWidgets)


ui <- fluidPage(
  title = "Examples of DataTables",
  tabsetPanel(
    id = 'dataset',
    tabPanel("tab 1", DT::dataTableOutput("tab1"), verbatimTextOutput('printMsg')),
    tabPanel("tab 2", DT::dataTableOutput("tab2")),
    tabPanel("tab 2", DT::dataTableOutput("tab3"))
  )
  
)

server <- function(input, output, session) {
  
  printText <- reactiveValues(run_id = '')
  
  buttonInput <- function(FUN, len, id, ...) {
    inputs <- character(len)
    for (i in seq_len(len)) {
      inputs[i] <- as.character(FUN(paste0(id, i), ...))
    }
    inputs
  }
  
  vals <- reactiveValues()
  
  #vals$Data <- data.table(
  vals$Data <- data.table(
    
    Brands = paste0("Brand", 1:10),
    Forecasted_Growth = sample(1:20, 10),
    Last_Year_Purchase = round(rnorm(10, 1000, 1000) ^ 2),
    Contact = paste0("Brand", 1:10, "@email.com"),
    
    'Lane Summary' = buttonInput(
      FUN = actionButton,
      len = 10,
      id = 'button_',
      label = "+",
      onclick = 'Shiny.onInputChange(\"lastClick\",  this.id)'
    )
  )
  
  
  output$tab1 <- DT::renderDataTable({
    DT = vals$Data
    datatable(DT, escape = F)
  })
  
  observeEvent(input$lastClick, {
    selectedRow <- as.numeric(strsplit(input$lastClick, "_")[[1]][2])
    printText$run_id <<- paste('clicked on ',vals$Data[selectedRow,1])
    #change tabs
    updateTabsetPanel(session, "dataset",
                      selected = "tab 2")
    
  })
  
  output$printMsg <- renderText({
    printText$run_id
  })
  
}

shinyApp(ui, server)