闪亮:如何根据数据在 table 中创建操作 links,然后使用 link 中的数据执行过滤器?

Shiny: How can I create action links in a table based on the data, and then perform a filter using data from the link?

我有两个 table 有一个共享密钥。第一个 table 总是显示在 UI 中。我希望用户能够单击 table 中的 link,然后显示一个模态对话框,该对话框是根据单击的 link 过滤的第二个 table .

具体示例:将 mtcars 显示为 table,gear 列可点击 link。单击其中一个时,例如 4,将出现一个模式对话框,显示所有具有 4 个齿轮的汽车。如果单击 3,您将获得所有带 3 个齿轮的汽车。

似乎无论如何都无法通过 shiny::actionLink() 传递参数,这就是我假设我想要用于 table link 的参数。我意识到我下面的例子没有正确创建 links,但不知道第二步是如何工作的(作用于 links)我只是留下了一些伪代码作为例子。

library(shiny)
library(tidyverse)


ui <- fluidPage(

    # Application title
    titlePanel("mtcars"),

        mainPanel(
           tableOutput("table")
        )
    )


server <- function(input, output) {

    output$table <- renderTable({
        mtcars %>% 
            mutate(gear = actionLink("gearinput", label = gear)) #I realize this does not work, just leaving here as pseudo code.
    })
    
    observeEvent(input$gearinput, {
      showModal(modalDialog(
        title = "Gear filter",
        mtcars %>% filter(gear == input$gearinput)), #I can't figure out how to actually get the value based on the link clicked
      )
    })
     
    
}

# Run the application 
shinyApp(ui = ui, server = server)


我对dplyr不是很熟悉所以我切换到data.table

我们可以向 actionLinks 添加一个 onclick 事件,并通过 Shiny.setInputValue:

提供点击的齿轮以发光
library(shiny)
# library(dplyr)
library(data.table)

DT <- copy(mtcars)
setDT(DT)

ui <- fluidPage(
  titlePanel("mtcars"),
  mainPanel(
    tableOutput("table")
  )
)

server <- function(input, output) {
  
  output$table <- renderTable({
    DT[, inputId := paste0("gear_input_", seq_len(.N))][, gear_links := as.character(actionLink(inputId = inputId, label = inputId, onclick = sprintf("Shiny.setInputValue(id = 'gear_click', value = %s);", gear))), by = inputId][, inputId := NULL]
  }, sanitize.text.function = function(x){x})
  
  observeEvent(input$gear_click, {
    showModal(modalDialog(
      title = "Gear filter",
      tableOutput("filtered_table"),
      size = "xl"
    ))
  })
  
  output$filtered_table <- renderTable({
    req(input$gear_click)
    DT[gear == input$gear_click][, c("gear_links", "vs") := NULL]
  })
  
}

shinyApp(ui = ui, server = server)

您可能希望将链接的标签更改为 gear - 但这样更容易理解。

关于此的有用链接:

r shiny table not rendering html

https://shiny.rstudio.com/articles/communicating-with-js.html