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))
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)
})
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With