How to filter one datatable from another on two tabs in shiny

Viewed 1040

I have one data set that is a summary data set by a particular category. I have another data set that provides the detailed information for each category (from which we calculated the summary stats).

I want to be able to have both datasets in tabs, but I want to be able to click on one line of the summary dataset and call up only the data for that particular category.

So, if I have a set of summary means for the each species of the iris data set:

     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

I want to be able to click on a line, and then call up a subset of the data for each species. For example, if I click on the line for Setosa, I want to see the following in the second tab:

   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
...

I have looked for some clues, but have not been able to find anything that works well.

Any help would be appreciated. I have included a working shiny app below:

#### 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)

UPDATE:

Using @JasonAizkalns suggestion below, I tried to implement this in Shiny, but am getting and error ("'data' must be 2-dimensional (e.g. data frame or matrix)") in the second tab.

Here is my code:

#### 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)
2 Answers

This is easier (and more succinct) to show in an html_notebook, but the concepts are generally the same. Basically you need to identify which row was selected in the DataTable. You do this via input$TABLE_ID_data_rows_selected -- admittedly, this feels awkward. In my example, my TABLE_ID is summary_data and therefore, we use input$summary_data_rows_selected and not input$summary_data$rows_selected or something similar.

We should also take care of a few things:

  • Use selection = "single" in our renderDataTable call to make sure the user can only click on one row.
  • We should throw in a validate(need()) statement to ensure the user has selected at least one record and give a friendly message if they have not.

Finally, if you want to make this two tabs, change the Column line to read 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)
})

No row selected

Selected Row

Related