mercredi 1 juin 2016

How can I use a "For" loop to map multiple polygons with the leaflet within shiny in R?

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)


} 

How can I get this code to map the multiple states? What is incorrect about my leaflet calls?




Aucun commentaire:

Enregistrer un commentaire