DataTable 中的 Actionbutton 不起作用，Shiny DT

Question

我正在尝试创建带有导航面板的闪亮应用程序。 navBar 上的第一个选项卡将是一个摘要 table，我想让其中的第一列内容可点击并导航到其详细信息选项卡内容。我已经将文本设为 hyperlink，但我想知道我实际上如何使 onClick 导航起作用。

_______________________Updating Question______________________

所以我根据得到的建议做了一些更新。我只是使用函数 actionLink()，结合 ObserveEvent({updateNavPanel})

看来主要问题是 DT table 内的 actionLink 无法工作，但在外部它工作正常。也许我只是缺少一些回调函数让它识别 DT 中的按钮？

下面是代码：摘要 1 显示有效的操作 link，摘要 2 显示 DT 中的操作 link 无效。

---
title: "Fruit Dashboard"
output: 
  flexdashboard::flex_dashboard:
    orientation: columns
    vertical_layout: fill
runtime: shiny
---

```{r global, include=FALSE, echo=FALSE}

# import libraries

library(DT)
library(shiny)
library(tidyverse)
library(shinythemes)
library(shinydashboard)
```

```{r, echo = FALSE}

shinyApp(

  ui <- fluidPage(
    titlePanel("Fruit Dashboard"), 
    theme = shinytheme("united"),
    navlistPanel(id='nav', widths = c(2, 10),
              tabPanel('Summary1', actionLink('apple', 'go to apple')),
             tabPanel('Summary2', dataTableOutput('summary')),
              tabPanel("apple", dataTableOutput('apple')),
              tabPanel("orange", dataTableOutput('orange')),
              tabPanel("watermelon", dataTableOutput('watermelon'))
    )

  ),

  server <- function(input, output, session) {

    observeEvent(input$apple, {

    updateNavlistPanel(session, "nav", 'apple')

  })


    output$summary <- renderDataTable({

      data <- data.frame('Fruit' = c('apple', 'orange', 'watermelon'),
                     'Count' = c(3,4,5)) %>%
        mutate(Fruit = paste0("<a id='", Fruit, "' hrep='#' class='action-button'>", Fruit, "</a>" ))

      table <- datatable(data, escape = FALSE , selection = 'none')

      table
    })

    output$apple <- renderDataTable({

      data <- data.frame('Total#' = 3, 'Organic#'= 2, 'Conventional#'=1)

      table <- datatable(data, escape = FALSE)
      table
    })


    output$orange <- renderDataTable({

      data <- data.frame('Total#' = 4, 'Organic#'= 3, 'Conventional#'=1)

      table <- datatable(data, escape = FALSE)
      table
    })

    output$watermelon <- renderDataTable({

      data <- data.frame('Total#' = 5, 'Organic#'= 2, 'Conventional#'= 3)

      table <- datatable(data, escape = FALSE)
      table
    })
  }
)


```

Answer 1

从这里的答案中获得灵感：

我猜关键是在DT里面创建actionLinks的时候加上on.click参数，让点击触发事件。 on.click 也可以为 actionLink/button 分配唯一的按钮 ID。然后在observeEvent中，简单的把表达式作为input$selected_button。请参阅下面的完整代码：

---
title: "Fruit Dashboard"
output: 
flexdashboard::flex_dashboard:
   orientation: columns
   vertical_layout: fill
runtime: shiny
---

```{r global, include=FALSE, echo=FALSE}

# import libraries

library(DT)
library(shiny)
library(tidyverse)
library(shinythemes)
library(shinydashboard)

df <- data.frame('Fruit' = c('apple', 'orange', 'watermelon'),
                     'Count' = c(3,4,5))

shinyInput <- function(FUN, len, id, label, ...) {
  inputs <- character(len)

  for (i in seq_len(len)) {
    label <- df$Fruit[i]
    inputs[i] <- as.character(FUN(paste0(id, i),label=label, ...))
  }
  inputs
 }

```

```{r, echo = FALSE}

shinyApp(

  ui <- fluidPage(
    titlePanel("Fruit Dashboard"), 
    theme = shinytheme("united"),
    navlistPanel(id='nav', widths = c(2, 10),
              tabPanel('Summary2', dataTableOutput('summary')),
              tabPanel("apple", dataTableOutput('apple')),
              tabPanel("orange", dataTableOutput('orange')),
              tabPanel("watermelon", dataTableOutput('watermelon'))
    )

  ),

  server <- function(input, output, session) {

    output$summary <- renderDataTable({

      data <- df %>%
        mutate(Fruit = shinyInput(actionLink, nrow(df), 'button_', label = Fruit, onclick = 'Shiny.onInputChange(\"select_button\",  this.id)' ))

  table <- datatable(data, escape = FALSE , selection = 'none')

  table
    })

observeEvent(input$select_button, {
   selectedRow <- as.numeric(strsplit(input$select_button, "_")[[1]][2])

  updateNavlistPanel(session, 'nav', df[selectedRow, 1])
})

output$apple <- renderDataTable({

  data <- data.frame('Total#' = 3, 'Organic#'= 2, 'Conventional#'=1)

  table <- datatable(data, escape = FALSE)
  table
})


output$orange <- renderDataTable({

  data <- data.frame('Total#' = 4, 'Organic#'= 3, 'Conventional#'=1)

  table <- datatable(data, escape = FALSE)
  table
})

output$watermelon <- renderDataTable({

  data <- data.frame('Total#' = 5, 'Organic#'= 2, 'Conventional#'= 3)

  table <- datatable(data, escape = FALSE)
  table
    })
  }
)


```

DataTable 中的 Actionbutton 不起作用，Shiny DT

Actionbutton within DataTable doesn't work, Shiny DT

javascript

r

shiny

dt

shinyjs