make a interactive bar chart using plotly and shiny have color and a back button

Question

I created an interactive bar chart in shiny and it is working well however there are 2 things I cannot get working.

adding color to the bar chart for each region.
having a back button so after you drill down from Region to Item Type you can click back to just see Region.

Any help is much appreciated. below is the file and code

library(shiny)
library(plotly)
library(dplyr)

dput(head(sales,100))
structure(list(Region = c("Sub-Saharan Africa", "Europe", "Middle East and North Africa", 
"Sub-Saharan Africa", "Europe", "Sub-Saharan Africa", "Asia", 
"Asia", "Sub-Saharan Africa", "Central America and the Caribbean", 
"Sub-Saharan Africa", "Europe", "Europe", "Asia", "Middle East and North Africa", 
"Australia and Oceania", "Central America and the Caribbean", 
"Europe", "Middle East and North Africa", "Europe", "Sub-Saharan Africa", 
"Europe", "Europe", "Asia", "Europe", "Europe", "Europe", "Europe", 
"Australia and Oceania", "Central America and the Caribbean", 
"Europe", "Europe", "Central America and the Caribbean", "Europe", 
"Central America and the Caribbean", "Middle East and North Africa", 
"Asia", "Europe", "Sub-Saharan Africa", "Central America and the Caribbean", 
"Europe", "Asia", "Middle East and North Africa", "Europe", "Middle East and North Africa", 
"Europe", "Europe", "Central America and the Caribbean", "Australia and Oceania", 
"Middle East and North Africa", "Europe", "Australia and Oceania", 
"Sub-Saharan Africa", "Sub-Saharan Africa", "Asia", "Sub-Saharan Africa", 
"Europe", "Europe", "Central America and the Caribbean", "Europe", 
"Middle East and North Africa", "Central America and the Caribbean", 
"Europe", "Europe", "Europe", "Sub-Saharan Africa", "Sub-Saharan Africa", 
"Sub-Saharan Africa", "Europe", "Europe", "Europe", "Europe", 
"Sub-Saharan Africa", "Sub-Saharan Africa", "Europe", "Central America and the Caribbean", 
"Sub-Saharan Africa", "Middle East and North Africa", "Europe", 
"Central America and the Caribbean", "Asia", "Middle East and North Africa", 
"North America", "Sub-Saharan Africa", "Sub-Saharan Africa", 
"Europe", "Europe", "Sub-Saharan Africa", "Europe", "Sub-Saharan Africa", 
"Central America and the Caribbean", "Sub-Saharan Africa", "Middle East and North Africa", 
"Australia and Oceania", "Middle East and North Africa", "Europe", 
"Sub-Saharan Africa", "Europe", "Sub-Saharan Africa", "Sub-Saharan Africa"
), Country = c("Chad", "Latvia", "Pakistan", "Democratic Republic of the Congo", 
"Czech Republic", "South Africa", "Laos", "China", "Eritrea", 
"Haiti", "Zambia", "Bosnia and Herzegovina", "Germany", "India", 
"Algeria", "Palau", "Cuba", "Vatican City", "Lebanon", "Lithuania", 
"Mauritius", "Ukraine", "Russia", "Japan", "Russia", "Liechtenstein", 
"Greece", "Albania", "Federated States of Micronesia", "Dominica", 
"Andorra", "Switzerland", "Trinidad and Tobago", "San Marino", 
"Nicaragua", "Azerbaijan", "Bangladesh", "Serbia", "Mauritius", 
"Jamaica", "Italy", "Bhutan", "Turkey", "Bulgaria", "Pakistan", 
"Poland", "France", "Jamaica", "Australia", "Somalia", "Slovenia", 
"Samoa", "South Africa", "Ghana", "Sri Lanka", "Guinea", "Spain", 
"Moldova", "Dominican Republic", "Luxembourg", "Kuwait", "Saint Lucia", 
"Georgia", "Bosnia and Herzegovina", "Iceland", "Mauritius", 
"Malawi", "Seychelles", "Montenegro", "Germany", "Estonia", "Serbia", 
"Madagascar", "Benin", "Hungary", "Cuba", "Senegal", "Algeria", 
"Bosnia and Herzegovina", "Antigua and Barbuda", "Cambodia", 
"Oman", "United States of America", "Mauritania", "Central African Republic", 
"Albania", "Switzerland", "Ghana", "Austria", "Democratic Republic of the Congo", 
"Dominican Republic", "Mauritius", "Libya", "Samoa", "Kuwait", 
"Hungary", "Senegal", "Moldova", "Eritrea", "Niger"), Item_Type = c("Office Supplies", 
"Beverages", "Vegetables", "Household", "Beverages", "Beverages", 
"Vegetables", "Baby Food", "Meat", "Office Supplies", "Cereal", 
"Baby Food", "Office Supplies", "Household", "Clothes", "Snacks", 
"Beverages", "Beverages", "Personal Care", "Snacks", "Cosmetics", 
"Office Supplies", "Snacks", "Cosmetics", "Meat", "Vegetables", 
"Clothes", "Baby Food", "Baby Food", "Beverages", "Office Supplies", 
"Personal Care", "Baby Food", "Vegetables", "Fruits", "Cosmetics", 
"Personal Care", "Beverages", "Fruits", "Baby Food", "Cereal", 
"Clothes", "Clothes", "Cosmetics", "Household", "Cereal", "Baby Food", 
"Baby Food", "Personal Care", "Fruits", "Cosmetics", "Clothes", 
"Cereal", "Vegetables", "Office Supplies", "Meat", "Fruits", 
"Personal Care", "Cereal", "Personal Care", "Office Supplies", 
"Fruits", "Vegetables", "Cosmetics", "Snacks", "Personal Care", 
"Office Supplies", "Meat", "Personal Care", "Household", "Meat", 
"Clothes", "Baby Food", "Beverages", "Clothes", "Cosmetics", 
"Fruits", "Vegetables", "Personal Care", "Baby Food", "Personal Care", 
"Vegetables", "Baby Food", "Office Supplies", "Cosmetics", "Baby Food", 
"Vegetables", "Household", "Vegetables", "Household", "Clothes", 
"Baby Food", "Cosmetics", "Office Supplies", "Personal Care", 
"Meat", "Beverages", "Personal Care", "Beverages", "Personal Care"
), Sales_Channel = c("Online", "Online", "Offline", "Online", 
"Online", "Offline", "Online", "Online", "Online", "Online", 
"Offline", "Offline", "Online", "Online", "Offline", "Offline", 
"Online", "Online", "Offline", "Offline", "Offline", "Online", 
"Offline", "Offline", "Offline", "Offline", "Online", "Offline", 
"Online", "Offline", "Online", "Online", "Offline", "Online", 
"Online", "Online", "Online", "Online", "Offline", "Offline", 
"Offline", "Offline", "Online", "Offline", "Offline", "Offline", 
"Offline", "Offline", "Online", "Offline", "Online", "Offline", 
"Online", "Online", "Offline", "Online", "Offline", "Online", 
"Online", "Online", "Offline", "Online", "Offline", "Offline", 
"Online", "Online", "Online", "Online", "Online", "Online", "Offline", 
"Online", "Offline", "Offline", "Online", "Online", "Offline", 
"Online", "Online", "Online", "Online", "Online", "Offline", 
"Offline", "Offline", "Online", "Online", "Online", "Online", 
"Offline", "Online", "Offline", "Offline", "Online", "Online", 
"Online", "Offline", "Offline", "Offline", "Online"), Order_Priority = c("L", 
"C", "C", "C", "C", "H", "L", "C", "L", "C", "M", "M", "C", "C", 
"C", "L", "H", "L", "H", "H", "H", "C", "L", "H", "L", "L", "C", 
"C", "M", "H", "M", "M", "L", "H", "L", "M", "L", "H", "H", "H", 
"H", "L", "L", "L", "M", "C", "M", "C", "H", "C", "M", "C", "M", 
"L", "M", "C", "L", "M", "L", "L", "L", "C", "H", "H", "H", "M", 
"C", "C", "L", "L", "H", "M", "C", "H", "M", "L", "H", "M", "M", 
"H", "H", "C", "L", "L", "H", "H", "M", "M", "H", "L", "L", "H", 
"C", "M", "H", "C", "C", "H", "M", "C"), Order_Date = c("1/27/2011", 
"12/28/2015", "1/13/2011", "9/11/2012", "10/27/2015", "7/10/2012", 
"2/20/2011", "4/10/2017", "11/21/2014", "7/4/2015", "7/26/2016", 
"10/20/2012", "2/22/2015", "8/27/2016", "6/21/2011", "9/19/2013", 
"11/15/2015", "4/6/2015", "4/12/2010", "9/26/2011", "5/14/2016", 
"8/14/2010", "4/13/2012", "9/19/2013", "12/2/2015", "2/26/2017", 
"10/9/2016", "5/20/2011", "10/24/2013", "6/14/2011", "6/20/2015", 
"8/5/2011", "11/30/2016", "7/5/2015", "3/25/2015", "8/22/2013", 
"12/11/2016", "6/23/2013", "5/8/2015", "10/24/2016", "3/10/2013", 
"3/18/2012", "2/11/2015", "10/30/2012", "7/6/2012", "1/4/2011", 
"10/25/2013", "2/16/2016", "3/16/2014", "9/24/2016", "9/30/2010", 
"11/5/2010", "7/21/2017", "7/10/2013", "10/6/2012", "6/4/2011", 
"4/12/2014", "10/26/2015", "8/4/2011", "2/24/2017", "3/30/2011", 
"5/2/2015", "2/1/2014", "3/3/2012", "4/22/2015", "5/12/2011", 
"12/21/2011", "12/2/2010", "8/14/2010", "10/5/2010", "2/8/2012", 
"9/8/2012", "8/11/2011", "10/28/2012", "10/11/2013", "10/6/2016", 
"7/28/2017", "11/4/2016", "4/12/2016", "11/13/2014", "8/26/2012", 
"7/15/2014", "5/2/2011", "11/11/2013", "4/14/2011", "10/4/2012", 
"5/14/2013", "1/12/2013", "10/3/2012", "10/23/2010", "2/6/2014", 
"9/4/2011", "5/12/2016", "7/19/2015", "10/28/2012", "8/25/2016", 
"10/25/2013", "2/11/2011", "5/27/2016", "2/6/2012"), Order_ID = c(292494523, 
361825549, 141515767, 500364005, 127481591, 482292354, 844532620, 
564251220, 411809480, 327881228, 773452794, 479823005, 498603188, 
151717174, 181401288, 500204360, 640987718, 206925189, 221503102, 
878520286, 192088067, 746630275, 246883237, 967895781, 305029237, 
223957431, 510666692, 121455848, 332936227, 692031657, 365978467, 
392325484, 528934037, 603977954, 965943562, 233629691, 246147668, 
212921321, 763686978, 798493468, 637702119, 671986758, 912333714, 
540041816, 156722390, 434299266, 765008771, 611399734, 856333482, 
652983844, 574837148, 365692222, 289660394, 681165492, 594943845, 
956044280, 509828126, 771969211, 178453862, 835580909, 869961678, 
278519999, 478492200, 257427108, 723186051, 353942859, 848183858, 
374707877, 322626245, 351362788, 640653836, 540548217, 821407258, 
523904788, 109027135, 108073127, 672654092, 224693858, 406428754, 
230407607, 129491746, 606854999, 885983693, 260676658, 345045220, 
123513209, 900816953, 452005279, 672439515, 827793490, 704053533, 
157518470, 464799630, 272820842, 548818433, 530341231, 875250566, 
511720263, 688236653, 923598563), Ship_Date = c("2/12/2011", 
"1/23/2016", "2/1/2011", "10/6/2012", "12/5/2015", "8/21/2012", 
"3/20/2011", "5/12/2017", "1/10/2015", "7/20/2015", "8/24/2016", 
"11/15/2012", "2/27/2015", "9/2/2016", "7/21/2011", "10/4/2013", 
"11/30/2015", "4/27/2015", "5/19/2010", "10/2/2011", "6/18/2016", 
"8/31/2010", "4/22/2012", "9/28/2013", "12/26/2015", "2/28/2017", 
"10/13/2016", "6/19/2011", "12/3/2013", "7/20/2011", "7/21/2015", 
"9/1/2011", "1/9/2017", "7/29/2015", "5/9/2015", "8/30/2013", 
"1/13/2017", "7/18/2013", "5/13/2015", "11/24/2016", "4/4/2013", 
"5/4/2012", "3/2/2015", "11/3/2012", "8/1/2012", "2/21/2011", 
"12/10/2013", "3/22/2016", "4/27/2014", "10/29/2016", "11/11/2010", 
"12/5/2010", "8/22/2017", "7/26/2013", "10/21/2012", "7/24/2011", 
"4/15/2014", "12/15/2015", "8/27/2011", "4/14/2017", "4/12/2011", 
"6/14/2015", "2/26/2014", "4/10/2012", "5/13/2015", "5/15/2011", 
"1/18/2012", "12/25/2010", "9/16/2010", "11/14/2010", "3/18/2012", 
"9/20/2012", "8/19/2011", "11/7/2012", "10/27/2013", "10/20/2016", 
"7/31/2017", "11/25/2016", "5/1/2016", "12/20/2014", "9/22/2012", 
"8/15/2014", "5/4/2011", "12/17/2013", "5/20/2011", "11/21/2012", 
"6/10/2013", "2/2/2013", "11/12/2012", "11/20/2010", "3/28/2014", 
"9/4/2011", "6/26/2016", "8/20/2015", "11/24/2012", "9/25/2016", 
"11/3/2013", "2/26/2011", "6/13/2016", "2/26/2012"), Units_Sold = c(4484, 
1075, 6515, 7683, 3491, 9880, 4825, 3330, 2431, 6197, 724, 9145, 
6618, 5338, 9527, 441, 1365, 2617, 6545, 2530, 1983, 3345, 7091, 
725, 3784, 2835, 6477, 339, 2083, 6401, 16, 6684, 2191, 9353, 
3020, 5072, 9420, 7005, 803, 816, 9083, 4670, 8675, 9229, 6493, 
7659, 1950, 5623, 6962, 1285, 5941, 5310, 5802, 861, 5959, 3603, 
8327, 1699, 7318, 5814, 9848, 9112, 5330, 7257, 5678, 8412, 5307, 
3243, 1130, 4912, 2562, 9084, 1516, 3924, 2407, 95, 2148, 761, 
155, 1586, 8340, 735, 1118, 8871, 5403, 9158, 609, 7261, 8650, 
1344, 3941, 2070, 3394, 2605, 6425, 8611, 4947, 8252, 3375, 2194
), Unit_Price = c(651.21, 47.45, 154.06, 668.27, 47.45, 47.45, 
154.06, 255.28, 421.89, 651.21, 205.7, 255.28, 651.21, 668.27, 
109.28, 152.58, 47.45, 47.45, 81.73, 152.58, 437.2, 651.21, 152.58, 
437.2, 421.89, 154.06, 109.28, 255.28, 255.28, 47.45, 651.21, 
81.73, 255.28, 154.06, 9.33, 437.2, 81.73, 47.45, 9.33, 255.28, 
205.7, 109.28, 109.28, 437.2, 668.27, 205.7, 255.28, 255.28, 
81.73, 9.33, 437.2, 109.28, 205.7, 154.06, 651.21, 421.89, 9.33, 
81.73, 205.7, 81.73, 651.21, 9.33, 154.06, 437.2, 152.58, 81.73, 
651.21, 421.89, 81.73, 668.27, 421.89, 109.28, 255.28, 47.45, 
109.28, 437.2, 9.33, 154.06, 81.73, 255.28, 81.73, 154.06, 255.28, 
651.21, 437.2, 255.28, 154.06, 668.27, 154.06, 668.27, 109.28, 
255.28, 437.2, 651.21, 81.73, 421.89, 47.45, 81.73, 47.45, 81.73
), Total_Profit = c(566105, 16834.5, 411291.95, 1273303.59, 54669.06, 
154720.8, 304602.25, 319213.8, 139053.2, 782371.25, 64139.16, 
876639.7, 835522.5, 884666.74, 699662.88, 24316.74, 21375.9, 
40982.22, 164017.7, 139504.2, 344784.21, 422306.25, 390997.74, 
126055.75, 216444.8, 178973.55, 475670.88, 32496.54, 199676.38, 
100239.66, 2020, 167501.04, 210029.26, 590454.89, 7278.2, 881868.64, 
236065.2, 109698.3, 1935.23, 78221.76, 804662.97, 342964.8, 637092, 
1604646.23, 1076084.89, 678510.81, 186927, 539020.78, 174467.72, 
3096.85, 1032961.67, 389966.4, 513999.18, 54354.93, 752323.75, 
206091.6, 20068.07, 42576.94, 648301.62, 145698.84, 1243310, 
21959.92, 336482.9, 1261774.59, 313084.92, 210804.72, 670008.75, 
185499.6, 28317.8, 814065.76, 146546.4, 667128.96, 145323.76, 
61449.84, 176770.08, 16517.65, 5176.68, 48041.93, 3884.3, 152033.96, 
209000.4, 46400.55, 107171.48, 1119963.75, 939419.61, 877885.88, 
38446.17, 1203365.53, 546074.5, 222741.12, 289427.04, 198430.2, 
590114.78, 328881.25, 161010.5, 492549.2, 77470.02, 206795.12, 
52852.5, 54981.64), Month_RecentYear = c(NA, NA, NA, NA, NA, 
NA, NA, "April", NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, "February", NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, "July", NA, NA, NA, NA, NA, NA, "February", NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, "July", 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA)), class = c("tbl_df", "tbl", "data.frame"
), row.names = c(NA, -100L))


ui <- fluidPage(
    plotlyOutput("Region", height = 200),
    plotlyOutput("Item_Type", height = 200),
    dataTableOutput("datatable")
)



axis_titles <- . %>%
    layout(
        xaxis = list(title = ""),
        yaxis = list(title = "Total Profit")
    )


server <- function(input, output, session) {
    Region <- reactiveVal()
    Item_Type <- reactiveVal()
    
    observeEvent(event_data("plotly_click", source = "Region"), {
        Region(event_data("plotly_click", source = "Region")$x)
        Item_Type(NULL)
    })
    
    observeEvent(event_data("plotly_click", source = "Item_Type"), {
        Item_Type(event_data("plotly_click", source = "Item_Type")$x)
    })
    
    output$Region <- renderPlotly({
        sales %>%
            count(Region, wt = Total_Profit) %>%
            plot_ly(x = ~Region, y = ~n, source = "Region") %>%
            axis_titles() %>%
            layout(title = "Total Profit by Region")
    })
    
    output$Item_Type <- renderPlotly({
        if (is.null(Region())) return(NULL)
        
        sales %>%
            filter(Region %in% Region()) %>%
            count(Item_Type, wt = Total_Profit) %>%
            plot_ly(x = ~Item_Type, y = ~n, source = "Item_Type") %>%
            axis_titles() %>%
            layout(title = Region())
    })
    
}

shinyApp(ui, server)

Instead of providing a link to your data, could you edit your question and provide a subset of your data using `dput` - at least enough to reproduce? — Ben, Feb 08 '20 at 21:18
Thanks, but if you don't mind, could you use use `dput` instead for your data? See here for how to make a [minimal reproducible example](https://stackoverflow.com/questions/5963269/how-to-make-a-great-r-reproducible-example). In general you'll get more responses than if you require a user to go to an external link to download data. If it's a large data set, perhaps you could do `dput(head(sales, 20))` or something like that or subset another way, and then copy/paste into your question. — Ben, Feb 09 '20 at 03:30
@Ben Ahh I'm fairly new to R and didn't realize you could do that. I think it is usable now. Thank you for your help! — josephl, Feb 09 '20 at 18:36

Ben · Accepted Answer · 2020-02-09T19:19:08.403

Thank you for adding the data with dput - that was very helpful.

To add colors, you can set color in your plot_ly statement to Region (so different colors for different region). If you want to set custom colors, then use colors as well, and set to a color vector, for example.

For the back button, you need another uiOutput to show the button (and hide when appropriate). If Region has been selected, then Region() will not be NULL and it should show the button. Otherwise should hide. Once the button is clicked, then input$clear should clear the Region() choice.

I also noticed the warnings including:

The 'plotly_click' event tied a source ID of 'Item_Type' is not registered.

That's a tough one, and there is a github issue on this. While we can register the plots, clearly the second plot as it is dependent on the first won't be registered when observeEvent is looking out for the plotly_click event.

As a workaround, you can make it observe instead, and add req to require that Region has been selected before doing anything with the plotly_click event. It seems like the warnings went away, I hope the behavior is still maintained.

library(shiny)
library(plotly)
library(dplyr)

my_colors = c("blue", "red", "green", "purple", "orange", "black", "pink")

###

ui <- fluidPage(
  plotlyOutput("Region", height = 400),
  plotlyOutput("Item_Type", height = 200),
  uiOutput("back"),
  dataTableOutput("datatable")
)

axis_titles <- . %>%
  layout(
    xaxis = list(title = ""),
    yaxis = list(title = "Total Profit")
  )

server <- function(input, output, session) {
  Region <- reactiveVal()
  Item_Type <- reactiveVal()

  observeEvent(event_data("plotly_click", source = "Region"), {
    Region(event_data("plotly_click", source = "Region")$x)
    Item_Type(NULL)
  })

  observe({
    req(Region())
    Item_Type(event_data("plotly_click", source = "Item_Type")$x)
  })

  output$Region <- renderPlotly({
    sales %>%
      count(Region, wt = Total_Profit) %>%
      plot_ly(x = ~Region, y = ~n, source = "Region", type = "bar", color = ~Region, colors = my_colors) %>%
      axis_titles() %>%
      layout(title = "Total Profit by Region") %>%
      event_register('plotly_click')
  })

  output$Item_Type <- renderPlotly({
    if (is.null(Region())) return(NULL)

    sales %>%
      filter(Region %in% Region()) %>%
      count(Item_Type, wt = Total_Profit) %>%
      plot_ly(x = ~Item_Type, y = ~n, source = "Item_Type", type = "bar") %>%
      axis_titles() %>%
      layout(title = Region()) %>%
      event_register('plotly_click')
  })

  # populate back button if category is chosen
  output$back <- renderUI({
    if (!is.null(Region())) 
      actionButton("clear", "Back", icon("chevron-left"))
  })

  # clear on back button press
  observeEvent(input$clear, Region(NULL))

}

shinyApp(ui, server)

thank you that worked great! I appreciate your help! – josephl Feb 09 '20 at 21:21 — josephl, Feb 09 '20 at 21:21

make a interactive bar chart using plotly and shiny have color and a back button

1 Answers1