Question

我有一个数据集，它是特定类别的摘要数据集。我还有另一个数据集，该数据集提供每个类别的详细信息（我们从中计算出摘要统计信息）。

我希望能够在选项卡中同时包含两个数据集，但是我希望能够单击摘要数据集的一行并仅调出该特定类别的数据。

因此，如果我对虹膜数据集的每种种类都有一套汇总方法：

     Species Sepal.Length Sepal.Width Petal.Length Petal.Width n..
1     setosa        5.006       3.428        1.462       0.246  50
2 versicolor        5.936       2.770        4.260       1.326  50
3  virginica        6.588       2.974        5.552       2.026  50

我希望能够单击一行，然后为每个物种调用数据的子集。例如，如果我单击Setosa的行，则希望在第二个选项卡中看到以下内容：

   Sepal.Length Sepal.Width Petal.Length Petal.Width Species
1           5.1         3.5          1.4         0.2  setosa
2           4.9         3.0          1.4         0.2  setosa
3           4.7         3.2          1.3         0.2  setosa
4           4.6         3.1          1.5         0.2  setosa
5           5.0         3.6          1.4         0.2  setosa
...

我一直在寻找一些线索，但找不到任何行之有效的方法。

任何帮助将不胜感激。我在下面包含了一个运行正常的闪亮应用程序：

#### Shiny app test #### 

#### Read in necessary libraries ####

library(shiny)
library(flexdashboard)
library(shinydashboard)
library(shinythemes)
library(DT)
library(dplyr)

#### Necessary functions 

#### create some data ####

data1<-iris %>%
  group_by(Species) %>%
  dplyr::summarize(Sepal.Length=mean(Sepal.Length,na.rm=TRUE),
                   Sepal.Width=mean(Sepal.Width,na.rm=TRUE),
                   Petal.Length=mean(Petal.Length,na.rm=TRUE),
                   Petal.Width=mean(Petal.Width,na.rm=TRUE),
                   n())

data2<-iris

#### UI function ####

ui <- dashboardPage(

 dashboardHeader(title="Shiny Tool"),

 dashboardSidebar(),

 dashboardBody(
        tabsetPanel(

          tabPanel("page1",
                   div(DT::dataTableOutput("page1"), style=c("color:black"))
          ),

          tabPanel("page2",
                   div(DT::dataTableOutput("page2"), style=c("color:black"))
          )
       )

    )
)

#### Server function ####

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

    output$page1 = DT::renderDataTable({
      data1
    })

    output$page2 <-  DT::renderDataTable({
        data2
    })

  })

shinyApp(ui = ui, server = server)

更新：

使用下面的@JasonAizkalns建议，我尝试在Shiny中实现此功能，但在第二个选项卡中却出现错误（“数据必须是二维的（例如，数据帧或矩阵）”）。

这是我的代码：

#### Shiny app test #### 

#### Read in necessary libraries ####

library(shiny)
library(flexdashboard)
library(shinydashboard)
library(shinythemes)
library(DT)
library(dplyr)

#### Necessary functions 

#### create some data ####

data1<-iris %>%
  group_by(Species) %>%
  dplyr::summarize(Sepal.Length=mean(Sepal.Length,na.rm=TRUE),
                   Sepal.Width=mean(Sepal.Width,na.rm=TRUE),
                   Petal.Length=mean(Petal.Length,na.rm=TRUE),
                   Petal.Width=mean(Petal.Width,na.rm=TRUE),
                   n())

data2<-iris

#### UI function ####

ui <- dashboardPage(

 dashboardHeader(title="Shiny Tool"),

 dashboardSidebar(),

 dashboardBody(
        tabsetPanel(

          tabPanel("page1",
                   div(DT::dataTableOutput("page1"), style=c("color:black"))
          ),

          tabPanel("page2",
                   div(DT::dataTableOutput("page2"), style=c("color:black"))
          )
       )

    )
)

#### Server function ####

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

  selected_row   = reactive({validate(need(selected_row > 0, "Please select a row."))
                            input$summary_data_rows_selected})

  selected_species = reactive(data1$Species[selected_row])

  temp = reactive(data2 %>% dplyr::filter(Species==selected_species))

    output$page1 = DT::renderDataTable({
      data1
    }, selection = 'single')


    output$page2 <-  DT::renderDataTable({
        temp
    })

  })

shinyApp(ui = ui, server = server)

Answer 1

在html_notebook中显示起来更容易（也更简洁），但是概念通常是相同的。基本上，您需要identify which row was selected in the DataTable。您通过input$TABLE_ID_data_rows_selected进行操作-诚然，这很尴尬。在我的示例中，我的TABLE_ID是summary_data，因此，我们使用input$summary_data_rows_selected和 not input$summary_data$rows_selected或类似的名称。

我们还应该注意一些事项：

在我们的selection = "single"调用中使用renderDataTable，以确保用户只能单击一行。
我们应该添加validate(need())语句，以确保用户选择了至少一条记录，如果没有，则给出友好的消息。

最后，如果要创建两个选项卡，请将Column行更改为Column {.tabset}。

---
title: "Selecting a Row in a DataTable"
output: flexdashboard::flex_dashboard
runtime: shiny
---

```{r setup, include=FALSE}
library(dplyr)
library(DT)
```

Column
-------------------------------------

### Summary Table    
```{r}    
dataTableOutput("summary_data")

my_table <- iris %>%
  group_by(Species) %>%
  add_count() %>%
  summarise_all(mean)

output$summary_data <- renderDataTable({
  my_table
}, selection = 'single')
```   

### Details        
```{r}
renderTable({
  selected_row     <- input$summary_data_rows_selected
  selected_species <- my_table$Species[selected_row]

  validate(need(selected_row > 0, "Please select a row."))

  iris %>%
    filter(Species == selected_species)
})

Answer 2

如果您想进一步了解Jason的出色回答，那么rstudio :: conf2018的本次演讲（https://www.rstudio.com/resources/videos/drill-down-reporting-with-shiny/）和相关代码（https://github.com/bborgesr/rstudio-conf-2018）很有帮助。

如何在闪亮的两个选项卡上从另一个过滤另一个数据表

2 个答案: