使用 plotly 和闪亮的颜色和后退按钮制作交互式条形图

Question

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

1. adding color to the bar chart for each region.

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

---

Answer 1

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)