R: Come cambiare il colore di sfondo della trama per un intervallo specifico nell'app ggvis shiny

Question

Ho una semplice app lucida come di seguito e puoi eseguirla. I grafici sono creati da ggvis e l'utente può scegliere il nome dello studente da inputSelect. Nelle trame, voglio cambiare il colore dello sfondo nell'intervallo di punteggio specifico. Ad esempio, in ciascun grafico, il colore dello sfondo di trama per il punteggio superiore a 80 o inferiore a 50 viene evidenziato con il blu (vedere la figura allegata). Stavo cercando di aggiungere livelli e disegnare rettangoli sulla trama usando layer_rects(), ma il problema è che i valori dell'asse x sono cambiati se vengono scelti studenti diversi. Qualcuno ha fatto questo prima o qualche idea? Ed è possibile se voglio che vengano visualizzati solo i punti nell'intervallo di punteggio? Molte grazie!

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

Per avere la larghezza dei rettangoli a cambiare con la variabile x, è possibile utilizzare x = ~min(year) e x2 = ~max(year). Non sono sicuro di come rendere le variabili dipendenti dai limiti di scala attuali, il che sembra che sarebbe una soluzione migliore. Ma questo dovrebbe funzionare. Ad esempio, il rettangolo inferiore sarebbe

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

Non è vettorializzare per i diversi limiti (almeno non sembrava essere), in modo da poter scrivere una funzione per semplificare avere più rettangoli. L'intero server assomiglierebbe

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") 
}) 

Per la seconda domanda, se desideri solo i punti di presentarsi in tale intervallo, si può fare un sottoinsieme di dati da utilizzare per la layer_points o un vettore logica (convertito in numerico con +) e l'uso che come argomento opacity,

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) 
})