基于用户输入闪亮的ggplot突出显示的区域

Question

我有一个ggplot中创建的篮球半场，里面嵌入了Shiny中的sidebarPanel，我想根据用户输入突出显示“区域”。我想我可以使用renderUI和geom_rect（）这两行来获得我想要的东西，但是我尝试过的东西似乎没有用。有人能帮忙吗？

我附上了一个图像链接，希望有助于补充我的解释以及当前的代码。

谢谢！

Court Zones Example

teams <- c("Hawks","Celtics","Nets","Hornets","Bulls","Cavaliers", 
     "Mavericks","Nuggets","Pistons","Warriors","Rockets","Pacers", 
     "Clippers","Lakers","Grizzlies","Heat","Bucks","Timberwolves", 
     "Pelicans","Knicks","Thunder","Magic","76ers","Suns","Trail 
     Blazers", "Kings","Spurs","Raptors","Jazz","Wizards") 

server <- function(input, output) { 

output$half_court <- renderPlot({ 

ggplot() + geom_polygon(data = court[court$side==1,], aes(x = x, y = y, 
group = group), col = "gray") + 
coord_equal() + 
xlim(-2,50) + 
ylim(-2,50) + 
scale_x_continuous(breaks = c(0, 25, 50)) + 
scale_y_continuous(breaks = c(0, 12.5, 25, 37.5, 50)) + 
xlab("") + ylab("") + 
theme(axis.text.x = element_blank(), 
     axis.text.y = element_blank(), axis.ticks.x = element_blank(), 
     axis.ticks.y = element_blank(), axis.title = element_blank()) + 
theme(panel.background = element_rect(fill = 'white')) + 
geom_rect(aes_string(xmin = 0, xmax = 10, ymin = 37.6, ymax = 47), fill 
= "yellow", alpha = 0.20) + 
geom_rect(aes_string(xmin = 40, xmax = 50, ymin = 0, ymax = 9.4), fill 
= "green", alpha = 0.20) 
}, bg = "transparent") 
} 

ui <- fluidPage(
titlePanel(title=div(img(src="primary.png", height = 50, width = 
50),strong("Database"))), 
    sidebarLayout(
    sidebarPanel(
    selectInput("season", "Season",c("","2016","2015","2014")), 
    selectInput("team", "Team 1",c("",teams)), 
    selectInput("team", "Team 2",c("",teams)), 
    selectInput("pass", "Pass Location",c("",1:25)), 
    selectInput("poss", "Possession Location",c("",1:25)), 
    plotOutput(outputId = "half_court") 
), 
mainPanel() 
) 
) 

shinyApp(ui = ui, server = server) 

Answer 1

使用基地的情节，你可以有一个透明的情节（renderPlot({...}, bg="transparent")），添加透明的矩形（rect(..., col = rgb(0, 50, 255, 50, maxColorValue = 256))）给它，并添加图片作为通过CSS（HTML("#plot{background:url(https://...)}))）的背景。

对于一个示例应用程序，见下图：

bckpic <- "https://thedatagame.files.wordpress.com/2016/03/nba_court.jpg" 

pos <- function(x, y){ 
    xx <- x1 <- (x - 1)*5 + c(0, 5) 
    yy <- 25 - ((y - 1)*5 + c(0, 5)) 
    return(c(xx[1], yy[2], xx[2], yy[1])) 
} 

ui <- fluidPage(
    tags$style(type='text/css', HTML("#plot{background:url(https://thedatagame.files.wordpress.com/2016/03/nba_court.jpg); 
            background-size: 200px 200px; 
            background-repeat: no-repeat;}")), 
    selectInput("pass", "Pass Location", 1:25), 
    selectInput("possess", "Possession Location", 1:25, 25), 
    uiOutput("style"), 
    plotOutput("plot") 
) 


server <- function(input, output){ 
    output$plot <- renderPlot({ 
    par(mar = c(0,0,0,0)) 
    plot(0, 0, ylim = c(0,25), xlim = c(0, 25), type='p', yaxt = "n", 
     xaxt = "n", xlab = "", ylab = "") 
    nr <- as.numeric(input$pass) 
    posi <- pos(ifelse(nr%%5 > 0, nr%%5, 5),ceiling(nr/5)) 
    rect(posi[1], posi[2], posi[3], posi[4], col = rgb(0, 50, 255, 50, maxColorValue = 256)) 

    nr <- as.numeric(input$possess) 
    posi <- pos(ifelse(nr%%5 > 0, nr%%5, 5),ceiling(nr/5)) 
    rect(posi[1], posi[2], posi[3], posi[4], col = rgb(255, 50, 0, 50, maxColorValue = 256)) 

    }, bg="transparent", width = 200, height = 200) 
} 

runApp(shinyApp(ui, server), launch.browser = TRUE)