R: Как изменить цвет фона графика для определенного диапазона в блестящем приложении ggvis

Question

У меня есть простое блестящее приложение, как показано ниже, и вы можете запустить его. Сюжеты созданы ggvis и пользователь может выбрать имя студента из inputSelect, На графиках я хочу изменить цвет фона в определенном диапазоне очков. Например, на каждом графике цвет фона графика для оценки выше 80 или ниже 50 выделяется синим цветом (см. Прилагаемое изображение). Я пытался добавить слои и нарисовать прямоугольники на графике, используя layer_rects(), но проблема в том, что значения оси X изменяются, если выбираются разные ученики. Кто-нибудь делал это раньше или есть идеи? И возможно ли, если я хочу, чтобы выскакивали только очки в этом диапазоне очков? Большое спасибо!

  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

Чтобы ширина прямоугольников изменялась с помощью переменной оси X, вы можете использовать x = ~min(year) а также x2 = ~max(year), Я не уверен, как сделать переменные зависимыми от текущих пределов масштаба, что, кажется, было бы более хорошим решением. Но это должно работать. Например, нижний прямоугольник будет

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

Он не векторизован для разных пределов (по крайней мере, так не казалось), поэтому вы можете написать функцию, упрощающую использование нескольких прямоугольников. Весь сервер будет выглядеть

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

Что касается вашего второго вопроса, если вы хотите, чтобы в этом диапазоне отображались только точки, вы можете создать подмножество данных, которые будут использоваться для layer_points или логический вектор (преобразуется в числовой с +) и использовать это как 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)
})