Question

我创建了一个看起来像这样的闪亮应用程序：

## Library
library(shiny)
library(shinydashboardPlus)
library(shinyjs)
library(DT)

data <- cbind(
  seq(from = 1, to = 30, by = 1),
  sample(seq(from = 100, to = 300, by = 10), size = 30, replace = TRUE),
  sample(seq(from = 1, to = 100, by = 9), size = 30, replace = TRUE),
  sample(seq(from = 50, to = 60, by = 2), size = 30, replace = TRUE),
  sample(seq(from = 100, to = 130, by = 1), size = 30, replace = TRUE)
) %>% 
  as.data.frame()

names(data) <- c("Colimn 1", "Colimn 2", "Colimn 3", "Colimn 4", "Colimn 5")

## UI
ui <- dashboardPagePlus(
  dashboardHeaderPlus(
    enable_rightsidebar = TRUE,
    rightSidebarIcon = "angle-left"
  ),
  dashboardSidebar(),
  dashboardBody(dataTableOutput("dataTable")),
  rightSidebar()
)

## Server
server <- function(input, output) { 
  output$dataTable <- renderDataTable({
    datatable(data,
    rownames= FALSE,
    selection = "single",
    escape = FALSE,
    ## Get the name of the row on click
    callback = JS("table.on('click.dt', 'tr',
                  function() {
                  Shiny.onInputChange('rows', table.rows(this).data().toArray());
                  });")
    )
  })

  observeEvent(!is.null(input$rows),
               {
              ????
               })
}

shinyApp(ui, server)

我想拥有的是，当用户单击数据表行时，右侧边栏会展开，其中包含该行的更多详细信息。

用户单击数据表的任何行后，侧栏将打开，如果用户单击任何其他行，则应保持打开状态。仅当按下顶部的按钮（已经存在）以折叠它时，它才应该折叠。

我试图在shinyjs::removeClass周围玩耍，但是我没有设法使其发挥作用。

Answer 1

使用library(shinyjs)将shinyjs::useShinyjs()添加到仪表板主体，然后在服务器功能中添加：

selected_row <- reactive({
    if(!is.null(input$rows)){
      shinyjs::addClass(selector = "aside.control-sidebar", class = "control-sidebar-open")
      data %>% filter(`Colimn 1`== input$rows[1])
    }
  })

闪亮：通过点击数据表来展开右侧边栏

1 个答案: