0

upon running the below script, I get two grouped bar plots and an infoBox. I want to make it such that when I click on any bar in the red group, I should get the sum of all the bars in that group in the infobox above. Similarly for the Green group besides. That means the infobox will have only two values, one for the red and one for green category. I have the script and I shall give the snap too.

library(shiny)
library(shinydashboard)
library(ggplot2)
library(plotly)

ui <- dashboardPage(
dashboardHeader(title = "Sankey Chart"),
dashboardSidebar(
width = 0
),
dashboardBody(
fluidRow(
column(10,
         uiOutput('box1'),
         tags$br()),
  tags$br(),
  column(10,


         box(title = "Case Analyses",status = "primary",solidHeader = 
  T,width = 1050,height = 452,
             plotlyOutput("case_hist"))
  ))
  )
  )
  server <- function(input, output) 
  { 
  output$case_hist <- renderPlotly(
  {

  iris$iris_limits <- cut(iris$Sepal.Length, c(1,3,6,9))
  iris$ID <- factor(1:nrow(iris))
  gg <- ggplot(iris, aes(x=ID, y=Sepal.Length, fill=iris_limits)) + 
    geom_bar(stat="identity", position="dodge") +
    facet_wrap(~iris_limits, scales="free_x", labeller=label_both) +
    theme_minimal() + xlab("") + ylab("Sepal Length") +
    theme(axis.text.x=element_blank())
  ggplotly(gg)
  }
  )
  output$box1 <- renderUI({
  tagList(
  infoBox("Total Cases", "a" , icon = icon("fa fa-briefcase"))
  )
  })
  }
  shinyApp(ui, server)

Total Bars in Grouped Bar Plots

Ashmin Kaul
  • 860
  • 2
  • 12
  • 37

1 Answers1

0

You could do something like this using event_data("plotly_click").

library(shiny)
library(shinydashboard)
library(ggplot2)
library(plotly)

ui <- dashboardPage(
  dashboardHeader(title = "Sankey Chart"),
  dashboardSidebar(
    width = 0
  ),
  dashboardBody(
    fluidRow(
      column(10,
             uiOutput('box1'),
             tags$br()),
      tags$br(),
      column(10,


             box(title = "Case Analyses",status = "primary",solidHeader = 
                   T,width = 1050,height = 452,
                 plotlyOutput("case_hist"))
      ))
  )
)
server <- function(input, output) 
{ 
  dat <- reactiveValues(Val = iris)

  output$case_hist <- renderPlotly(
    {
      dat$Val$iris_limits <- cut(iris$Sepal.Length, c(1,3,6,9))
      dat$Val$ID <- factor(1:nrow(iris))
      iris$iris_limits <- cut(iris$Sepal.Length, c(1,3,6,9))
      iris$ID <- factor(1:nrow(iris))
      gg <- ggplot(iris, aes(x=ID, y=Sepal.Length, fill=iris_limits)) + 
        geom_bar(stat="identity", position="dodge") +
        facet_wrap(~iris_limits, scales="free_x", labeller=label_both) +
        theme_minimal() + xlab("") + ylab("Sepal Length") +
        theme(axis.text.x=element_blank())
      ggplotly(gg)
    }
  )

  output$box1 <- renderUI({
    d <- event_data("plotly_click")
    tc <- c()
    if(!is.null(d)){

      if(d$curveNumber == 0)#pink click
      {
        tc <- sum(dat$Val$Sepal.Length[which(dat$Val$iris_limits == "(3,6]")])


      }else#green click
      {
        tc <- sum(dat$Val$Sepal.Length[which(dat$Val$iris_limits == "(6,9]")])
      }
    }
      tagList(
        infoBox("Total Cases", tc , icon = icon("fa fa-briefcase"))
      )


  })
}
shinyApp(ui, server)

HereI have used reactiveValue so that the count could be calculated when the plot is clicked. Other option would be that you save the values inside the reactiveValue instead of saving the data. Something like this:

library(shiny)
library(shinydashboard)
library(ggplot2)
library(plotly)

ui <- dashboardPage(
  dashboardHeader(title = "Sankey Chart"),
  dashboardSidebar(
    width = 0
  ),
  dashboardBody(
    fluidRow(
      column(10,
             uiOutput('box1'),
             tags$br()),
      tags$br(),
      column(10,


             box(title = "Case Analyses",status = "primary",solidHeader = 
                   T,width = 1050,height = 452,
                 plotlyOutput("case_hist"))
      ))
  )
)
server <- function(input, output) 
{ 
  dat <- reactiveValues(Val1 = c(), Val2 = c())

  output$case_hist <- renderPlotly(
    {

      iris$iris_limits <- cut(iris$Sepal.Length, c(1,3,6,9))
      iris$ID <- factor(1:nrow(iris))

      dat$Val1 <- sum(iris$Sepal.Length[which(iris$iris_limits == "(3,6]")])
      dat$Val2 <- sum(iris$Sepal.Length[which(iris$iris_limits == "(6,9]")])
      gg <- ggplot(iris, aes(x=ID, y=Sepal.Length, fill=iris_limits)) + 
        geom_bar(stat="identity", position="dodge") +
        facet_wrap(~iris_limits, scales="free_x", labeller=label_both) +
        theme_minimal() + xlab("") + ylab("Sepal Length") +
        theme(axis.text.x=element_blank())
      ggplotly(gg)
    }
  )

  output$box1 <- renderUI({
    d <- event_data("plotly_click")
    tc <- c()
    if(!is.null(d)){

      if(d$curveNumber == 0)#pink click
      {
        tc <- dat$Val1


      }else#green click
      {
        tc <- dat$Val2
      }
    }
      tagList(
        infoBox("Total Cases", tc , icon = icon("fa fa-briefcase"))
      )


  })
}
shinyApp(ui, server)
SBista
  • 7,479
  • 1
  • 27
  • 58
  • This one is on similar lines, please help. https://stackoverflow.com/questions/47132076/setting-ranges-for-a-bar-chart-in-r-and-displaying-count-of-items – Ashmin Kaul Nov 06 '17 at 07:54