閃亮的 ggvis 反應圖

Question

我想制作Shiny app ，它根據我使用ggvis包選擇的參數繪制自定義圖形。

如果我選擇所有品牌，我想得到這個情節：

但是當我只選擇一個特定品牌時，情節應該是這樣的：

我嘗試了不同的方法，但沒有一個給我預期的結果。

你能提出一個想法如何解決這個問題嗎？

我還包括可重現的示例：

library(shiny)
library(shinydashboard)
library(plyr)
library(ggvis)


# Header -----------------------------------------------------------

header <- dashboardHeader(title= "DashBoard")


# Sidebar --------------------------------------------------------------

sm <- sidebarMenu(

  menuItem(
    text="GGVIS",
    tabName="GGVIS",
    icon=icon("eye")
  )  

)

sidebar <- dashboardSidebar(sm)

# Body --------------------------------------------------

body <- dashboardBody(

  # Layout  --------------------------------------------  

  tabItems(


    tabItem(
      tabName="GGVIS",
      fluidPage(

        fluidRow(

          title = "Inputs", status = "warning", width = 2, solidHeader = TRUE, collapsible = TRUE,



          uiOutput("Category"),
          uiOutput("Brand"),
          uiOutput("Values"),
          ggvisOutput("p")






        )
      )
    )
  )
)

# Setup Shiny app UI components -------------------------------------------

ui <- dashboardPage(header, sidebar, body)

# Setup Shiny app back-end components -------------------------------------

server <- function(input, output) {

  set.seed(1992)
  n=101

   Letter <- sample(c("a", "b", "c"), n, replace = TRUE, prob = NULL)
   Category <- sample(c("Car", "Bus", "Bike"), n, replace = TRUE, prob = NULL)
   Brand <- sample("Brand", n, replace = TRUE, prob = NULL)
   Brand <- paste0(Brand, sample(1:14, n, replace = TRUE, prob = NULL))
   USD <- abs(rnorm(n))*100

   df <- data.frame(Letter, Category, Brand, USD)



  # Inputs --------------------------------------

   output$Category <- renderUI({
    selectInput("Category", "Choose category:", 
                choices = c("Car","Bus", "Bike" ))
  })


  output$Brand <- renderUI({

df2 <- df[df$Category %in% input$Category,]

  selectInput("Brand", 
                "Brand:", 
                c("All", unique(as.character(df2$Brand)))) 
  })


  # ----------------------------------------------------------------------------- 


data2 <-  reactive({


  df <- df[df$Category %in% input$Category,]
  df <- df[df$Brand %in% input$Brand,] # if I comment this line, I get All brands graph
  df <- droplevels(df)  

  df <- ddply(df, c("Letter", "Category", "Brand"), summarise, "USD" = sum(USD))

})   


data2%>% group_by(Brand) %>%
  ggvis(x = ~factor(Letter, levels = c("a", "b", "c")), y = ~USD, fill =    ~Brand, fillOpacity := 1) %>%
  layer_bars() %>%
  add_axis("x", title = "Letter") %>% bind_shiny("p")







  # -----------------------------------------------------------------------------


}

# Render Shiny app --------------------------------------------------------

shinyApp(ui, server)

Answer 1

嘗試

1) 不將 df 更改為反應式

    data2 <-  reactive({

    df3=df
      df3 <- df3[df3$Category %in% input$Category,]
      df3 <- df3[df3$Brand %in% input$Brand,] # if I comment this line, I get All brands graph
      df3 <- droplevels(df3)  

      df3<- ddply(df3, c("Letter", "Category", "Brand"), summarise, "USD" = sum(USD))

})  

2）添加if語句

    if(!"All" %in% input$Brand){
    df3 <- df3[df3$Brand %in% input$Brand,] # if I comment this line, I get All brands graph
    }