title: coupled event in Plotly's bar-plot
body: <p>I have a bar-plot the click action of which produces another plot alongside the bar-plot.
  As of now the user can only click on one <code>agegroup</code> and have the corresponding race distribution. Is there a way to enable multiple <code>agegroup</code> selections and subset the race data accordingly ?</p>
  
  <p>Took inspiration of this plot from
  <a href="https://plot.ly/r/shiny-coupled-events/" rel="nofollow noreferrer">https://plot.ly/r/shiny-coupled-events/</a></p>
  
  <p><a href="https://i.stack.imgur.com/vYuSI.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/vYuSI.png" alt="enter image description here"></a></p>
  
  <p>The code is as under</p>
  
  <pre><code>    ui &lt;- fluidPage(
    theme = shinytheme("spacelab"),
  
    h2("Coupled events in plotly charts using Shiny"),
    h4("This Shiny app showcases coupled events using Plotly's ", tags$code("event_data()"), " function."),
  
    tags$hr(),
  
    fixedRow(
      column(6, plotlyOutput("Plot1", height = "600px")),
      column(6, plotlyOutput("Plot2", height = "600px"))))
  
  
  
  
  
  
  
      server &lt;- function(input, output){
  
          patdata_age&lt;- subset(patdata, select="agegroup")
      patdata_age&lt;-as.data.frame(table(patdata_age))
      selection&lt;-patdata_age
  
      output$Plot1 &lt;- renderPlotly({
        colnames(selection)&lt;-c("agegroup","Freq")
        selection$y&lt;-round((patdata_age$Freq*100/sum(patdata_age$Freq)))
        plot_ly(source = "subset",selection, x = ~agegroup, y = selection$y, type = 'bar',
                marker = list(color = 'rgb(255,140,0)',    
                              # marker = list(color,alpha = d),
                              line = list(color = 'rgb(8,48,107)', width = 1.5))) %&gt;%
          layout(title = paste0("Age-group distribution of patients "),xaxis = list(title = 'age group'),dragmode =  "select",
                 yaxis = list(title = paste0('Percentage of Patients')),titlefont=list(size=13),
                 annotations = list(x = ~agegroup, y = selection$y, text = paste0(selection$y, "%"),
                                    xanchor = 'center', yanchor = 'bottom',
                                    showarrow = FALSE))    })
  
  
  
      output$Plot2 &lt;- renderPlotly({
  
        eventdata &lt;&lt;- event_data("plotly_click", source = "subset")
        validate(need(!is.null(eventdata), "Click the age plot to populate this race plot"))
  
        datapoint &lt;&lt;- as.numeric(eventdata$pointNumber)[1]
        sel&lt;&lt;-patdata  %&gt;% filter(dp %in% datapoint)
  
  
        raceselection&lt;-subset(sel,select="Race")
        raceselection&lt;-as.data.frame(table(raceselection))
        colnames(raceselection)&lt;-c("Race","Freq")
        raceselection$y&lt;-round((raceselection$Freq*100/sum(raceselection$Freq)))
  
        raceall&lt;-merge(raceselection,boston_race)
  
  
        raceall$Race&lt;- as.character(raceall$Race)
        raceall$Percent&lt;-round(raceall$Percent,0)
  
  
  
        plot_ly(raceall, x = ~Race, y = ~Percent, type = 'bar', name = 'Total Population',marker = list(color = 'rgb(255,140,0)',
                                                                                                        line = list(color = 'rgb(8,48,107)', width = 1))
        ) %&gt;%
          add_trace(y = ~y, name = 'Patient Population',marker = list(color = 'rgb(49,130,189)',
                                                                      line = list(color = 'rgb(8,48,107)', width = 1))) %&gt;%
          layout(yaxis = list(title = 'Population Percent'), barmode = 'group',
                 title = paste0("Patient Race comparison"))
  
  
  
      })
  </code></pre>
  
  <p>Data snippet:
  patdata</p>
  
  <pre><code>Race    Ethnicity   dp  agegroup
  Latino Hispanic Puerto Rican    1   20-29
  African American    Not Hispanic or Latino  2   30-39
  White   Not Hispanic or Latino  4   50+
  White   Russian 4   50+
  Asian   American    1   20-29
  White   Not Hispanic or Latino  2   30-39
  White   Unknown/not specified   1   20-29
  White   Not Hispanic or Latino  0   &lt;20
  African American    American    0   &lt;20
  Asian   Asian   3   40-49
  White   Not Hispanic or Latino  1   20-29
  Latino Hispanic Unknown/not specified   0   &lt;20
  White   Not Hispanic or Latino  0   &lt;20
  White   Unknown/not specified   1   20-29
  Unknown Unknown/not specified   1   20-29
  Latino Hispanic Dominican   2   30-39
  White   European    4   50+
  White   American    4   50+
  White   Unknown/not specified   0   &lt;20
  </code></pre>
  
  <p>bostonrace:</p>
  
  <pre><code>Race    Percent
  White   47
  Unknown 0
  Other   1.8
  Latino Hispanic 17.5
  Asian   8.9
  African American    22.4
  </code></pre>