Skip to content

Instantly share code, notes, and snippets.

@garrettgman
Last active December 22, 2015 11:19
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save garrettgman/6465117 to your computer and use it in GitHub Desktop.
Save garrettgman/6465117 to your computer and use it in GitHub Desktop.
A shiny app that helps you map demographic variables from the 2010 US Census
library(shiny)
if(!require(maps)) stop("This app requires the maps package.\nPlease install it and then try again.")
if(!require(mapproj)) stop("This app requires the maps package.\nPlease install it and then try again.")
counties <- readRDS("counties.RDS")
mp <- map("county", plot=FALSE, namesonly=TRUE)
c.order <- match(mp,
paste(counties$region, counties$subregion, sep = ","))
shinyServer(function(input, output) {
indexInput <- reactive({
var <- switch(input$var,
"Total Population (logged)" = log(counties$pop),
"Percent White" = counties$white,
"Percent Black" = counties$black,
"Percent Hispanic" = counties$hispanic,
"Percent Asian" = counties$asian)
var <- pmax(var, input$range[1])
var <- pmin(var, input$range[2])
as.integer(cut(var, 100, include.lowest = TRUE,
ordered = TRUE))[c.order]
})
shadesInput <- reactive({
switch(input$var,
"Percent White" = colorRampPalette(c("white", "darkgreen"))(100),
"Percent Black" = colorRampPalette(c("white", "black"))(100),
"Percent Hispanic" = colorRampPalette(c("white", "darkorange3"))(100),
"Percent Asian" = colorRampPalette(c("white", "darkviolet"))(100))
})
legendText <- reactive({
inc <- diff(range(input$range)) / 4
c(paste0(input$range[1], " % or less"),
paste0(input$range[1] + inc, " %"),
paste0(input$range[1] + 2 * inc, " %"),
paste0(input$range[1] + 3 * inc, " %"),
paste0(input$range[2], " % or more"))
})
output$mapPlot <- renderPlot({
fills <- shadesInput()[indexInput()]
map("county", fill = TRUE, col = fills,
resolution = 0, lty = 0, projection="polyconic",
myborder = 0, mar = c(0,0,0,0))
map("state",col = "white", fill=FALSE, add=TRUE, lty=1,
lwd=1,projection="polyconic", myborder = 0,
mar = c(0,0,0,0))
legend("bottomleft", legend = legendText(),
fill = shadesInput()[c(1, 25, 50, 75, 100)],
title = input$var)
})
})
library(shiny)
shinyUI(pageWithSidebar(
headerPanel("censusVis"),
sidebarPanel(
helpText("Create demographic maps with information from the 2010 US Census."),
selectInput("var", "Choose a variable to display",
choices = c(
"Percent White",
"Percent Black",
"Percent Hispanic",
"Percent Asian"
),
selected = "Percent White"
),
sliderInput("range", "Range of interest:",
min = 0, max = 100, value = c(0, 100))
),
mainPanel(
plotOutput("mapPlot", height = "600px")
)
))
@blid92
Copy link

blid92 commented Dec 14, 2015

thanks for the code, i noticed you used 'county' as dataset is it included in R, is it possible to apply this code for countries other than the US?

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment