CODEWITHSUNDEEP
rdynamicggplot2shinyspatial
Abb
Abb

Reputation: 109

Highlight area of ggplot based on user input shiny

I have a basketball half court created in ggplot that I've embedded inside a sidebarPanel in Shiny and I would like to highlight "zones" of the court based on user input. I was thinking I could use something along the lines of renderUI coupled with geom_rect() to get what I want, but nothing I've tried seems to work. Can anyone help with this?

I've attached an image link that is hopefully helpful in supplementing my explanation above along with current code.

Thank you!

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)

Upvotes: 3

Views: 433

Answers (1)

Tonio Liebrand
Tonio Liebrand

Reputation: 17719

Using base plot you could have a transparent plot (renderPlot({...}, bg="transparent")), add transparent rectangles (rect(..., col = rgb(0, 50, 255, 50, maxColorValue = 256))) to it and add the picture as a background via CSS (HTML("#plot{background:url(https://...)}))).

enter image description here

For a sample app, see below:

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)

Upvotes: 1

Related Questions