helpers.R

# Note: percent map is designed to work with the counties data set
# It may not work correctly with other data sets if their row order does 
# not exactly match the order in which the maps package plots counties
percent_map <- function(var, color, legend.title, min = 0, max = 100) {

  # generate vector of fill colors for map
  shades <- colorRampPalette(c("white", color))(100)
  
  # constrain gradient to percents that occur between min and max
  var <- pmax(var, min)
  var <- pmin(var, max)
  percents <- as.integer(cut(var, 100, 
    include.lowest = TRUE, ordered = TRUE))
  fills <- shades[percents]

  # plot choropleth map
  map("county", fill = TRUE, col = fills, 
    resolution = 0, lty = 0, projection = "polyconic", 
    myborder = 0, mar = c(0,0,0,0))
  
  # overlay state borders
  map("state", col = "white", fill = FALSE, add = TRUE,
    lty = 1, lwd = 1, projection = "polyconic", 
    myborder = 0, mar = c(0,0,0,0))
  
  # add a legend
  inc <- (max - min) / 4
  legend.text <- c(paste0(min, " % or less"),
    paste0(min + inc, " %"),
    paste0(min + 2 * inc, " %"),
    paste0(min + 3 * inc, " %"),
    paste0(max, " % or more"))
  
  legend("bottomleft", 
    legend = legend.text, 
    fill = shades[c(1, 25, 50, 75, 100)], 
    title = legend.title)
}

server.R

library(shiny)

library(maps)
library(mapproj)
counties <- readRDS("data/counties.rds")
source("helpers.R")

shinyServer(function(input, output) {

	output$map <- renderPlot({
		data <- switch(
			input$var,
			"Percent White" = counties$white,
			"Percent Black" = counties$black,
			"Percent Hispanic" = counties$hispanic,
			"Percent Asian" = counties$asian
		)
		color <- switch(
			input$var,
			"Percent White" = "darkgreen",
			"Percent Black" = "black",
			"Percent Hispanic" = "darkorange",
			"Percent Asian" = "darkviolet"		
		)
		legend <- switch(
			input$var,
			"Percent White" = "% White",
			"Percent Black" = "% Black",
			"Percent Hispanic" = "% Hispanic",
			"Percent Asian" = "% Asian"			
		)
		percent_map(
			var = data,
			color = color,
			legend.title = legend,
			max = input$range[2],
			min = input$range[1]
		)
	})
})

ui.R

library(shiny)

shinyUI(fluidPage(
  titlePanel("censusVis"),

  sidebarLayout(
    sidebarPanel(
		helpText("Creating demographics from the 2020 census"),
		selectInput(
			"var",
			label="Choose a var to display",
			choices=c("Percent Black","Percent White","Percent Hispanic","Percent Asian","Percent Green"),
			selected="Percent Hispanic"
		),
		sliderInput(
			"range",
			label="Range of interests:",
			min=0, max=100, value=c(0,100)
		),
		checkboxGroupInput(
			"cbg",
			label=h3("Checkbox group"),
			choices=list("Waffles"=1,"Tarts"=2,"Eye Scream"=3),
			selected=1
		)

	),
    mainPanel(
		plotOutput("map")
	)
  )

))