сделать интерактивную гистограмму, используя сюжет и блестящий цвет и кнопку возврата - PullRequest
Новая
       0

сделать интерактивную гистограмму, используя сюжет и блестящий цвет и кнопку возврата

1 голос
/ 08 февраля 2020

Я создал блестящую интерактивную гистограмму, и она работает хорошо, однако есть две вещи, с которыми я не могу работать.

  1. добавление цвета на гистограмму для каждого региона.

  2. с кнопкой возврата, поэтому после перехода из области в область типа элемента вы можете нажмите, чтобы увидеть регион.

Любая помощь очень ценится. ниже находится файл и код 

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)

1 Ответ

0 голосов
/ 09 февраля 2020

Спасибо за добавление данных с помощью dput - это было очень полезно.

Чтобы добавить цвета, вы можете установить color в своем выражении plot_ly на Region (поэтому разные цвета для другой регион). Если вы хотите установить пользовательские цвета, то также используйте colors и установите цветовой вектор, например.

Для кнопки back вам нужен еще один uiOutput, чтобы показать кнопку ( и прятаться при необходимости). Если выбран регион, то Region() не будет NULL, и на нем должна отображаться кнопка. В противном случае следует скрыть. Как только кнопка нажата, input$clear должен очистить выбор * 1015.

Я также заметил предупреждения, включающие:

Событие 'plotly_click' связало идентификатор источника 'Item_Type' не зарегистрирован.

Это сложный вопрос, и в этом вопросе github . Хотя мы можем зарегистрировать графики, очевидно, что второй график, поскольку он зависит от первого, не будет зарегистрирован, когда observeEvent ищет событие plotly_click.

В качестве обходного пути вы можете сделать вместо этого observe и добавьте req, чтобы потребовать, чтобы был выбран Region, прежде чем делать что-либо с событием plotly_click. Кажется, что предупреждения ушли, я надеюсь, что поведение все еще сохраняется. 

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)
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Нет похожих вопросов

...