Question

我正在开发一个需要在条形图上进行多次钻取的应用程序。下面给出的是可复制的代码：

library(shiny)
library(plotly)
library(shinyWidgets)
library(shinythemes)
library(dplyr)

df <- data.frame(Level1=c("Tax","Tax","Tax","Tax","Non Tax","Non Tax","Non Tax","GIA","GIA","GIA","GIA"), 
                 Level2=c("GST","IT","Customs","GST","SS","GS","SS","Plan","Non_plan","Others","Others"), 
                 Total=c(1000,10000,200,534,724,6451,8335,8635,999,855,6638))
dfcategories<-unique(df$Level1)
ui<- navbarPage(title=span("Drill Down",style= {"color: green;font-size:150%"}),
                theme=shinytheme("spacelab"),
                header = tagList(
                  useShinydashboard()
                ),
                tabPanel("Bar Chart",
                         plotlyOutput("rrbar"), uiOutput("Back")
                ))
server<- function(input,output){
  current_category<-reactiveVal()
  rr1<-reactive({
    if(!length(current_category()))
    {
      return(count(df, Level1, wt=Total ))
    }
    df %>%filter(Level1==current_category())%>% count(Level2,wt=Total)
  })

  output$rrbar<- renderPlotly({
    d<-setNames(rr1(),c("x","y"))
    print(d)
    plot_ly(d) %>% 
      add_bars(x=~x,y =~y,color=~x)
  })

  observe({
    cd<-event_data("plotly_click")$x

    if(isTRUE(cd %in% dfcategories)) current_category(cd)
  })
  output$Back <- renderUI({
    if (length(current_category())) 
      actionButton("clear", "Back", icon("chevron-left"))
  })
  observeEvent(input$clear, current_category(NULL))
}
shinyApp(ui,server)

运行上面的代码时，它会产生两个手推车： 1.第一个柱状图将在Level1与Total之间 2.单击“级别1”中的任何类别时，第二个条形图将位于“级别2”（在“级别1”下）1与“总计”之间。

在第二张图表中，只有X轴应该只有选定Level1的Level2。但是我的代码产生了Level2的所有类别，而与Level1无关。 Result of Drill down。 X轴应仅具有SS和GS。为什么它具有所有Level2类别。？

我要去哪里错了？有什么帮助吗？在此先感谢

在R闪亮的仪表板中向下钻取无法正常工作

0 个答案: