Это требует блестящего решения:
lapply(c("shiny", "data.table", "ggplot2", "RColorBrewer", "ggrepel"),
require, character.only = TRUE)
# mangle data
marriage <- fread("masters.csv", header = TRUE)
marriage <- melt(marriage, id.vars = "State")
marriage$variable <- as.numeric(as.character(marriage$variable ))
setnames(marriage, c("State", "year", "rate"))
marriage$State <- tolower(marriage$State)
states_map <- map_data("state")
marriage <- merge(data.table(data.frame(state.center),
state.abb, State=tolower(state.name)), marriage, by="State")
# pick fixed color palette
myPalette <- colorRampPalette(rev(brewer.pal(11, "Spectral")))
sc <- scale_fill_gradientn(colours = myPalette(100),
limits = range(marriage$rate))
# Define UI
ui <- fluidPage(
titlePanel("Marriage"),
sidebarLayout(
sidebarPanel(
sliderInput("year", "Year", min(marriage$year),
max(marriage$year), value=min(marriage$year), step = 1)
),
mainPanel(
plotOutput(outputId = "box", height = "800px")
)
)
)
# Define server function
server <- function(input, output) {
output$box <- renderPlot({
req(input$year)
DT <- marriage[year==input$year]
ggplot(DT, aes(map_id = State)) +
geom_map(aes(fill = rate), map = states_map) +
expand_limits(x = states_map$long, y = states_map$lat) +
sc +
geom_text_repel(data=DT, aes(x=x, y=y, label = rate), size=10)
})
}
# Create Shiny object
shinyApp(ui = ui, server = server)
В ответ на запрос: версия stati c с двумя графиками с максимумами и минимумами для каждого состояния рядом друг с другом:
# Load packages
lapply(c("data.table", "ggplot2", "RColorBrewer", "ggrepel", "cowplot"),
require, character.only = TRUE)
# mangle data
marriage <- fread("masters.csv", header = TRUE)
marriage <- melt(marriage, id.vars = "State")
marriage$variable <- as.numeric(as.character(marriage$variable ))
setnames(marriage, c("State", "year", "rate"))
marriage$State <- tolower(marriage$State)
states_map <- map_data("state")
marriage <- merge(data.table(data.frame(state.center),
state.abb, State=tolower(state.name)), marriage, by = "State")
# pick fixed color palette
myPalette <- colorRampPalette(rev(brewer.pal(11, "Spectral")))
sc <- scale_fill_gradientn(colours = myPalette(100),
limits = range(marriage$rate))
# sort by State and rate
setkeyv(marriage, c("State", "rate"))
# pick year with largest and smallest rate (could be one of several)
DT.max <- marriage[, tail(.SD, 1), by = State]
DT.min <- marriage[, head(.SD, 1), by = State]
theme_set(theme_void())
# generate plot of maximum and minimum rates by State
p1 <- ggplot(DT.max, aes(map_id = State)) +
geom_map(aes(fill = rate), map = states_map) +
expand_limits(x = states_map$long, y = states_map$lat) +
sc +
geom_text_repel(data=DT.max, aes(x=x, y=y,
label = paste0(rate, "\n(",year,")")), size=3.5) +
ggtitle("Maximum marriage rate 1990-2017 \nby State (year measured)") +
theme(plot.title = element_text(hjust = 0.5))
p2 <- ggplot(DT.min, aes(map_id = State)) +
geom_map(aes(fill = rate), map = states_map) +
expand_limits(x = states_map$long, y = states_map$lat) +
sc +
geom_text_repel(data=DT.min, aes(x=x, y=y,
label = paste0(rate, "\n(",year,")")), size=3.5) +
ggtitle("Minimum marriage rate 1990-2017 \nby State (year measured)") +
theme(plot.title = element_text(hjust = 0.5))
# plot plots next to each other
cowplot::plot_grid(p1, p2, ncol=2)