Map Shiny Gist

App.R

library(shiny)
library(ggmap)
library(rgdal)
library(sp)
library(broom)
library(dplyr)
library(magrittr)
library(raster)
library(rgeos)

# paramters
zoom = 12
location <- "Seattle, WA"
maptype <- "roadmap"
zip_shape_file_dir <- '/Users/jonathanlisic/data/zip/cb_2016_us_zcta510_500k'

zips <- readOGR(zip_shape_file_dir,'cb_2016_us_zcta510_500k')

# things below here will need to change per new location
map <- get_map( location=location, maptype=maptype, zoom=zoom)
map_bb <- attr(map,'bb')



draw_zip <- c()



ui <- basicPage(
                  plotOutput("plot1", click = "plot_click"),
                    verbatimTextOutput("info")
                  )

server <- function(input, output) {
  # turn the bb into a spatial polygon
  poly_bb <- as(raster::extent(as.numeric(map_bb)[c(2,4,1,3)]), "SpatialPolygons")
  proj4string(poly_bb) <- proj4string(zips) 
  
  # get interects 
  zips_keep <- gIntersects(zips,poly_bb,byid=TRUE)
  zips_keep <- zips[which(zips_keep),]
  
  #tidy up the data
  zip_tidy <- tidy(zips_keep)
  zip_data <- zips_keep@data
  zip_data$id <- rownames(zip_data)
  zip_data$med <- runif( NROW(zip_data))
  zip_data <- left_join( zip_tidy, zip_data, by='id')
  
  p <- ggmap(map, extent = "normal", maprange = FALSE) +
       geom_polygon(data = zip_data, aes(long, lat, group = group, fill=med),
          color = "black", alpha = 0.4) +
       coord_map(
         xlim=c(map_bb$ll.lon, map_bb$ur.lon),
         ylim=c(map_bb$ll.lat, map_bb$ur.lat))



    output$plot1 <- renderPlot({ 
  
      if( !is.null( input$plot_click$x ) ) {
        my_point <- data.frame(long=input$plot_click$x,lat=input$plot_click$y) 
        coordinates(my_point) <- ~ long + lat
        proj4string(my_point) <- proj4string(zips)
        draw_zip <<- over(my_point, zips_keep)$ZCTA5CE10
      }
              
      if( length(draw_zip) > 0 ) { 
        p <- p + geom_polygon(
          data = zip_data %>% 
            filter( ZCTA5CE10 %in% draw_zip ),
              aes(long, lat, group = group),
              color = "yellow", alpha=0) 
      } 
      p
       
    })
    
  output$plot2 <- renderPlot({ 
  })

  output$info <- renderText({
      if( !is.null( input$plot_click$x ) ) {
        paste0("x=", input$plot_click$x, "\ny=", input$plot_click$y)
      }
          })
}

shinyApp(ui, server)