闪亮：renderPrint() 根据 input$id_cell_clicked 显示存储在表中的附加信息

Posted 2023-02-14

【中文标题】闪亮：renderPrint() 根据 input$id_cell_clicked 显示存储在表中的附加信息

【英文标题】：Shiny: renderPrint() show additional info stored in table basing on input$id_cell_clicked

【发布时间】：2022-01-22 05:05:20

【问题描述】：

我闪亮的应用程序根据两个输入（子组和类型）显示可用数据集表。在此表下方，我想打印所选行的附加信息（基本上是因为在一个表中显示所有行会使表输出混乱）。我在这个网站 (Shiny renderDataTable table_cell_clicked) 上发现了一个类似的问题，效果很好。但是，渲染的打印只包含所选单元格的信息（$row、$col 和 $value），但我想打印存储在 col 11 到 17 的同一数据集中的所选行的信息。

我认为问题在于我的 output$Availabledatasets 过滤了数据集，之后该对象不可用。我尝试了不同的东西，但没有任何帮助。我是闪亮和 DT（以及 ***）的新手，但我认为解决方案非常简单，我缺少一些基本的东西。很抱歉给您带来不便，非常感谢您的帮助。

提前致谢！

最小代码示例：

dataset <- read.xlsx("data/data.xlsx", sep.names = " ") 

ui <- fluidPage(
  mainPanel(
    selectInput(inputId = "Subgroup",
                label = "Choose a Subgroup",
                choices = unique(dataset$Subgroup)),
    uiOutput("secondSelection")
  ),
  sidebarPanel(
    DT::dataTableOutput(outputId = "Availabledatasets"),
    verbatimTextOutput(outputId = "info"))

#built server side function
server <- function(input, output)
  output$Availabledatasets <- renderDT(
    filtered <- dataset %>% filter(Subgroup == input$Subgroup,
                                   Type == input$Type) 
    datatable(filtered[1:10], selection = "single")
  )
  output$secondSelection <- renderUI(
    selectInput("Type", "Choose a Type", 
                choices = dataset[dataset$Subgroup == input$Subgroup, "Type"])
  )
  output$info <- renderPrint(
    req(length(input$Availabledatasets_cell_clicked)  > 0)
    input$Availabledatasets_cell_clicked #here I would like to display column 11 to 17 of my selected dataset 
  )

    

app <- shinyApp(ui = ui, server = server)

runApp(app)

【参考方案1】：

您可以使用input$Availabledatasets_cell_clicked$row 提供的信息过滤您的数据集，并且可以对列索引进行硬编码。

  output$info <- renderPrint(
    req(length(input$Availabledatasets_cell_clicked) > 0)
    dataset[input$Availabledatasets_cell_clicked$row, 11:17] 
  )

我使用mpg 数据集制作了一个可重现的示例。

library(shiny)
library(tidyverse)
library(DT)

# create data
writexl::write_xlsx(mpg, "dat.xlsx")
dataset <- readxl::read_xlsx("dat.xlsx")
file.remove("dat.xlsx")

ui <- fluidPage(
  sidebarPanel(
    selectInput(
      inputId = "Subgroup",
      label = "Choose a Subgroup",
      choices = unique(dataset$manufacturer)
    ),
    uiOutput("secondSelection")
  ),
  mainPanel(
    DT::dataTableOutput(outputId = "Availabledatasets"),
    verbatimTextOutput(outputId = "info")
  )
)

# built server side function
server <- function(input, output) 
  output$Availabledatasets <- renderDT(
    req(input$Subgroup)
    req(input$Type)
    filtered <- dataset %>% filter(
      manufacturer == input$Subgroup,
      class == input$Type
    )
    datatable(filtered, selection = "single")
  )
  output$secondSelection <- renderUI(
    selectInput("Type", "Choose a Type",
      choices = dataset[dataset$manufacturer == input$Subgroup, "class"]
    )
  )
  output$info <- renderPrint(
    req(length(input$Availabledatasets_cell_clicked) > 0)
    dataset[input$Availabledatasets_cell_clicked$row, 3:10] # here I would like to display column 11 to 17 of my selected dataset
  )




app <- shinyApp(ui = ui, server = server)

runApp(app)