shiny + ggvis: reactive using ggvis “tilde” or “~”

Question

All I want is an efficient way to set the ggvis fill property in server.R according to the InputSelect box in ui.R . Since the fill property syntax needs a " tilde " or " ~ " I was unable to come with a solution.

The ui.R and server.R below are just one of my solutions attempts: my switch statement below is wrong since I get a " Error in switch(select, mpg = { : EXPR must be a length 1 vector ". Don't hesitate to propose something completely different.

Thanks in advance for your support !

ui.R

shinyUI(fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput("select", label = h3("Select box"), 
                  choices = list("mpg" = "mpg", "hp" = "hp", "cyl" = "cyl"), 
                  selected = "mpg")
    ),
    mainPanel(
      uiOutput("ggvis_ui"),
      ggvisOutput("ggvis")
    )
  )
))

server.R

data(mtcars)

shinyServer(
  function(input, output) {
    select <- reactive({as.character(input$select)})
      data <- switch(select, 
                     mpg = {mtcars %>% 
                       ggvis(~mpg, ~wt, 
                             fill = ~mpg) %>% 
                       layer_points() %>%
                       bind_shiny("ggvis", "ggvis_ui")},
                     hp = {mtcars %>% 
                       ggvis(~mpg, ~wt, 
                             fill = ~hp) %>% 
                       layer_points() %>%
                       bind_shiny("ggvis", "ggvis_ui")},
                     cyl = {mtcars %>% 
                       ggvis(~mpg, ~wt, 
                             fill = ~cyl) %>% 
                       layer_points() %>%
                       bind_shiny("ggvis", "ggvis_ui")}
      )    
  }
)

Answer 1

You can try to running the select expression using select() , and wrap your switch in an observer to plot the data reactively:

The server.R would be:

shinyServer(
  function(input, output) {
    select <- reactive({as.character(input$select)})
    observe({
    data <- switch(select(), 
                   mpg = {mtcars %>% 
                            ggvis(~mpg, ~wt, 
                                  fill = ~mpg) %>% 
                            layer_points() %>%
                            bind_shiny("ggvis", "ggvis_ui")},
                   hp = {mtcars %>% 
                           ggvis(~mpg, ~wt, 
                                 fill = ~hp) %>% 
                           layer_points() %>%
                           bind_shiny("ggvis", "ggvis_ui")},
                   cyl = {mtcars %>% 
                            ggvis(~mpg, ~wt, 
                                  fill = ~cyl) %>% 
                            layer_points() %>%
                            bind_shiny("ggvis", "ggvis_ui")}
    ) 
    data
    })
  }
)