R: How to change plot background color for a specific range in ggvis shiny app

Question

I have a simple shiny app like below and you can run it. The plots are created by ggvis and user can choose student name from inputSelect. In the plots, I want to change the color of background in specific score range. For example, in each plot, the color of plot background for the score higher than 80 or lower than 50 are highlighted with blue(See picture attached). I was trying to add layers and draw rectangles onto plot using layer_rects(), but the problem is the values of x-axis are changed if different students are chosen.Anyone did this before or any ideas? And is it possible if I want only the points in that score range pop up? Thanks a lot!

  library(shiny)
    library(ggvis)

df <- data.frame(Student = c("a","a","a","a","a","b","b","b","b","b","c","c","c","c"),
                 year = c(seq(2001,2005,1),seq(2010,2014,1),seq(2012,2015,1)),
                 score = runif(14,min = 50,max = 100), stringsAsFactors=F)

ui = (fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput("stu","Choose Student",
                  choice = unique(df$Student))
    ),
    mainPanel(ggvisOutput("plot"))
    )
  )
)

server = function(input,output,session){   
  
  dataInput = reactive({
    gg = df[which(df$Student == input$stu),]
  })
  
  vis = reactive({
    data = dataInput()
    data %>%
      ggvis(x = ~year, y = ~score) %>%
      scale_numeric("y",domain = c(40,120))%>%
      layer_lines()
  })
  
  vis %>% bind_shiny("plot")
}

runApp(list(ui = ui, server = server))

Answer 1

To have the width of the rectangles to change with the x-axis variable, you can use x = ~min(year) and x2 = ~max(year). I'm not sure how to make the variables dependent on the current scale limits, which seems like it would be a nicer solution. But, this should work. For example, the lower rectangle would be

layer_rects(x = ~min(year), x2 =~max(year),
            y = 40-3.5, y2 = 50, opacity := 0.05, fill := "blue")

It isn't vectorized for different limits (at least it didn't look to be), so you can write a function to simplify having multiple rectangles. The whole server would look like

shinyServer(function(input,output,session){   

    dataInput = reactive({
        gg = df[which(df$Student == input$stu),]
    })

    buffer <- 3.5  # set to make the rectangle reach the scale boundaries
    rectLims <- list(lower=c(40-buffer, 80), upper=c(50, 120+buffer))
    make_rect <- function(vis, lims, buffer=buffer) {
        for (i in seq_along(lims$lower))
            vis <- layer_rects(vis, x = ~min(year), x2 =~max(year),
                        y = rectLims$lower[i], y2 = rectLims$upper[i],
                               opacity := 0.05, fill := "blue")
        vis
    }

    vis = reactive({
        data = dataInput()
        data %>%
          ggvis(x = ~year, y = ~score) %>%
          scale_numeric("y",domain = c(40,120)) %>%
          layer_points()%>%
          layer_lines() %>%
          make_rect(lims=rectLims)
    })

    vis %>% bind_shiny("plot")
})

For your second question, if you only want points to show up in that range, you can make a subset of the data to use for the layer_points or a logical vector (converted to numeric with +) and use that as the opacity argument,

vis = reactive({
    data = dataInput()

    ## Option 1: and use layer_points(data=inrange)
    ## inrange <- with(dataInput(), dataInput()[score >=80 | score <= 50,])

    ## Options 2, with opacity=~inrange
    inrange = +with(data, score >=80 | score <= 50)

    data %>%
      ggvis(x = ~year, y = ~score) %>%
      scale_numeric("y",domain = c(40,120)) %>%
      layer_points(opacity = ~inrange) %>%
      layer_lines() %>%
      make_rect(lims=rectLims)
})