rshinycrosstalk

Subset dataset based on crosstalk value in a shiny app


I use crosstalk in order to be able to click on a bar in the barplot and subset the table below based on the Abcd. For some reason if I press on a bar I get only one row of the dataset while I should get all of them. If I select all the bars again the table still displayes only one row.

---
title: "Operaitonal dashboard"
author: "Report"
date: 'Date: `r Sys.Date()`'
output: 
  flexdashboard::flex_dashboard:
    orientation: columns
    theme: lumen
    vertical_layout: scroll
---

```{r setup, include=FALSE}


knitr::opts_chunk$set(echo=FALSE,
                      warning= FALSE,
                      message = FALSE)
library(crosstalk)
library(shiny)
library(plotly)
library(flexdashboard)
library(ggplot2)
library(dplyr)
library(reactable)
##The four dataframes

Abcd<-c("A","A","B","B")
Prod<-c(34,56,56,89)
Div<-c("Ent","Ent","App","High")
dcross1<-data.frame(Abcd,Prod,Div)


Counts<-c(45,67,78,56)
dcross2<-data.frame(Div,Abcd,Counts)


shared_df <- SharedData$new(dcross1, key = ~Abcd, group = "group")
shared_df2 <- SharedData$new(dcross2, key = ~Abcd, group = "group")


```

# Out of stock Report {data-icon="fa-cart-arrow-down" data-orientation=rows}

## Row {data-height="200"}

### Out Of Stock: Store Overview {data-width="200"}

```{r Oos Store}
daily_store_oos_gg<-
  ggplot(shared_df,
         aes(x=Abcd,
             y=Prod,
             fill=as.factor(Abcd)
             )) +
  geom_bar(stat="identity", position="dodge") 

# Convert to plotly object
daily_store_oos_ply <- 
  ggplotly(daily_store_oos_gg)

daily_store_oos_ply
```

## Column {data-width=405}


### Store Overview Out of Stock
```{r out of stock reactable}
daily_item_oos_rctble<-reactable(
    shared_df2
    )

daily_item_oos_rctble

```

Solution

  • As suggested by someone, reactable does not work well with crosstalk. Perhaps your data could be prepared as shown below.

    Try this

    Abcd<-c("A","A","B","B")
    Prod<-c(34,56,56,89)
    Div<-c("Ent","Ent","App","High")
    dcross1<-data.frame(Abcd,Prod,Div)
    
    Countd<-c(45,67,78,56)
    dcross2<-data.frame(Div,Abcd,Countd)
    
    Store<-c(199,199)
    Abcd<-c("A","B")
    Oos<-c(500,400)
    store<-data.frame(Store,Abcd,Oos, flag=1)
    
    Man<-c("Corp","Adv","Corp","Adv")
    Abcd<-c("A","B","A","B")
    Counts<-c(45,56,34,78)
    Scounts<-c(23,45,67,67)
    Per<-c(1,2,3,5)
    supplier<-data.frame(Abcd,Man,Counts,Scounts,Per) # %>% SharedData$new() 
    supplier2 <- supplier[order(supplier$Abcd),]
    
    dcross <- cbind(dcross1[,2:3], dcross2[,2:3], supplier2[,2:5]) %>% mutate(id = row_number())
    
    dcross_sub <- group_by(dcross, Abcd) %>% slice(1) %>% select(Abcd, id)
    store_sub <- merge(x = dcross_sub, y = store, by = "Abcd", all = TRUE)
    
    dcrossf <- merge(x = dcross, y = store_sub[,2:5], by = "id", all = TRUE)
    
    ui <- fluidPage(
      bscols(widths = 6,
             list(
               plotlyOutput("storep"),
               DTOutput("dcross1t")
             )
      )
    )
    
    server <- function(input, output) {
      row.names(dcrossf) <- NULL
      
      dcross11 <- SharedData$new(dcrossf, key = ~Abcd, group = "group")
      store2 <- SharedData$new(subset(dcrossf, flag==1), key = ~Abcd, group = "group")
    
      daily_store_oos_gg<-
        ggplot(store2,
               aes(x=Abcd,
                   y=Oos,
                   fill=as.factor(Abcd)
               )) + labs(fill="Abcd") +
        geom_bar(stat="identity", position="dodge")
    
      # Convert to plotly object
      daily_store_oos_ply <-
        ggplotly(daily_store_oos_gg)
    
      output$storep <- renderPlotly({daily_store_oos_gg })
    
      output$dcross1t <- renderDT({dcross11}, server=FALSE)
    
    }
    
    shinyApp(ui, server)