I am currently struggling to map multiple polygons in a shiny app. The purpose of the shiny app is to take some data pertaining to disease spread in a number of states and map the areas of highest risk. The app must be able to map multiple states at the click of the "Start!" button.
(Note: This app is very large (6000+ lines in total) so only relevant code will be shown here, I don't want to burden the ones trying to help me)
Excerpts from:
Server.R
#The purpose of col_inputs and col_names is to create a two-dimensional array with all of the input parameters for the function. This was done to maintain compatibility with some legacy code. Catted_states on the other hand combines all states selected into a list. (Example: c("AZ","FL","VA")
length_of_states <- length(isolate(input$states))
catted_states <- array()
for (i in 1:length_of_states)
{
catted_states[i] <- isolate(input$states[i])
catted_states[i] <- array(catted_states[i])
}
col_inputs <- c(as.numeric(isolate(input$summary_level)),"NULL",
as.numeric(isolate(input$year)), age, isolate(input$gender), classs_r,
Months, as.numeric(isolate(input$travel_dfc)), isolate(as.numeric(input$travel_dnc)),
as.numeric(isolate(input$travel_doc)), as.numeric(isolate(input$sepdist)),
isolate(input$foutput), as.numeric(isolate(input$outprop)), as.numeric(isolate(input$cmtravel)),
as.numeric(isolate(input$in_risk)))
col_names <- c("Summary_level","State","Year", "Age", "Gender", "Class",
"Month", "Travel_DFC", "Travel_DNC", "Travel_DOC", "Separation distance",
"Output file", "Outprop", "CM travel", "In Risk")
output$gm <- renderLeaflet({
global_map(col_names, col_inputs, catted_states)
})
Global_Map.R
The only real concerns with this code is that 'M' isn't being drawn at all after the for loop finishes.
global_map <- function(col_names, col_inputs, catted_states) {
# ------------------------------------------------------------------------------#
# This function draws the map of risk
# ------------------------------------------------------------------------------#
# ------------------------------------------------------------------------------#
# Setting the work directory
# ------------------------------------------------------------------------------#
Temp_dir = "E:\\USDA\\CSUA V1.5\\"
setwd(Temp_dir)
# ------------------------------------------------------------------------------#
# Loading the map is intensive, loading as much ram as possible can help it move
# quicker
# ------------------------------------------------------------------------------#
options(java.parameters = "-Xmx12g")
# ------------------------------------------------------------------------------#
# Create the user_para.csv
# ------------------------------------------------------------------------------#
User_para <- array(0, dim = c(16, 2))
User_para[, 1] <- c("x", col_names)
User_para[, 2] <- c("x", col_inputs)
# ------------------------------------------------------------------------------#
# State Number file. LOOP INCOMING
# ------------------------------------------------------------------------------#
state_num_file <- read.csv("state_to_#.csv", header = FALSE)
# ------------------------------------------------------------------------------#
# The list of inputs for the mapping function to work. State fix is coming soon
# ------------------------------------------------------------------------------#
state_input <- catted_states
state_input <- toupper(state_input)
year_input <- User_para[which(User_para[, 1] == "Year"), 2]
state_num <- numeric(1)
# state_num <- statenum_file[which(state_num_file[, 1] == state_input), 2]
risk_input <- as.numeric(User_para[which(User_para[, 1] == "In Risk"), 2])
for (i in 1:length(catted_states)) {
state_num[i] <- state_num_file[which(state_num_file[, 1] == state_input[i]),
2]
# ------------------------------------------------------------------------------#
# Fixes the trailing 0 program (Will be a part of the loop))
# ------------------------------------------------------------------------------#
if (state_num[i] < 10) {
state_output <- readOGR(paste(Temp_dir, "Census Shape file\\TRACT\\2010",
"\\tl_", "2010_0", state_num[i], "_", "tract10", "\\tl_", "2010_0",
state_num[i], "_", "tract10.shp", sep = ""), layer = paste("tl_2010_0",
state_num[i], "_tract10", sep = ""), verbose = FALSE)
dbf_input <- read.dbf(paste("Census Shape file\\TRACT\\2010\\tl_2010_0",
state_num[i], "_tract10\\tl_2010_0", state_num[i], "_tract10.dbf",
sep = ""))
}
if (state_num[i] >= 10) {
state_output <- readOGR(paste(Temp_dir, "Census Shape file\\TRACT\\2010",
"\\tl_", "2010", "_", state_num[i], "_", "tract10", "\\tl_", "2010",
"_", state_num[i], "_", "tract10.shp", sep = ""), layer = paste("tl_2010",
"_", state_num[i], "_tract10", sep = ""), verbose = FALSE)
dbf_input <- read.dbf(paste("Census Shape file\\TRACT\\2010\\tl_2010_",
state_num[i], "_tract10\\tl_2010_", state_num[i], "_tract10.dbf",
sep = ""))
}
tmp_input <- paste("Data\\Data\\results\\Final_Risk", state_input[i], year_input,
sep = " ")
input <- read.csv(paste(Temp_dir, tmp_input, ".csv", sep = ""))
# --------------------
fin_risk <- ((100 - risk_input)/100)
quan = quantile(input[, 8], fin_risk)
inputre = input[which(input[, 8] > quan), ]
dbf_input[, 13] = c(0)
input[, 8] = as.numeric(cut(input[, 8], 5))
if (state_num[i] <= 10) {
inputre[, 4] <- as.character(paste("0", inputre[, 4], sep = ""))
}
for (i in 1:nrow(inputre)) {
dbf_input[which(dbf_input[, 4] == inputre[i, 4]), 13] <- inputre[i, 8]
}
state_output$risk <- dbf_input[, 13]
pal <- colorNumeric(palette = "Purples", domain = state_output$risk)
pal_sR <- pal(state_output$risk)
m <- addProviderTiles(m, "CartoDB.Positron")
m <- addLegend(m, title = "Risk", pal = pal, values = ~state_output$risk,
opacity = 0.7)
m <- addPolygons(m, stroke = FALSE, smoothFactor = 0, fillOpacity = 0.5,
color = ~pal_sR)
}
Aucun commentaire:
Enregistrer un commentaire