Nothing
#
# if (!require("pacman")) install.packages('pacman', repos='http://cran.r-project.org')
#
# pacman::p_load(shiny, ggplot2, plotly, reshape2, rgdal, RColorBrewer, ggdendro, dendextend)
#
# pacman::p_load_gh("rstudio/leaflet", "cloudyr/aws.s3")
#
# library(shiny)
# library(ggplot2)
# suppressMessages(library(plotly))
# library(leaflet)
# library(reshape2)
# library(rgdal)
# library(RColorBrewer)
# library(ggdendro)
# library(dendextend)
# library(Rnightlights)
# library(aws.s3)
missingPkgs <- NULL
wgs84 <- "+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0"
if (!requireNamespace("Rnightlights", quietly = TRUE))
{
missingPkgs <- c(missingPkgs, "Rnightlights")
}
if (!requireNamespace("shiny", quietly = TRUE))
{
missingPkgs <- c(missingPkgs, "shiny")
}
if (!requireNamespace("shinyjs", quietly = TRUE))
{
missingPkgs <- c(missingPkgs, "shinyjs")
}
if (!requireNamespace("dendextend", quietly = TRUE))
{
missingPkgs <- c(missingPkgs, "dendextend")
}
if (!requireNamespace("ggdendro", quietly = TRUE))
{
missingPkgs <- c(missingPkgs, "ggdendro")
}
if (!requireNamespace("leaflet", quietly = TRUE))
{
missingPkgs <- c(missingPkgs, "rstudio/leaflet")
}
if (!requireNamespace("plotly", quietly = TRUE))
{
missingPkgs <- c(missingPkgs, "plotly")
}
if (!requireNamespace("RColorBrewer", quietly = TRUE))
{
missingPkgs <- c(missingPkgs, "RColorBrewer")
}
if (!requireNamespace("reshape2", quietly = TRUE))
{
missingPkgs <- c(missingPkgs, "reshape2")
}
if (!requireNamespace("rgdal", quietly = TRUE))
{
missingPkgs <- c(missingPkgs, "rgdal")
}
if(!is.null(missingPkgs))
stop(Sys.time(), ": Missing packages needed for this function to work.
Please install missing packages: '", paste0(missingPkgs, collapse = ", "), "'", call. = FALSE)
#options(shiny.trace=T)
shiny::shinyServer(function(input, output, session){
#Since renderUI does not like intraCountry returning NULL we init with an empty renderUI, set suspendWhenHidden = FALSE to force it to recheck intraCountry even if null
output$intraCountry <- shiny::renderUI({})
shiny::outputOptions(output, "intraCountry", suspendWhenHidden = FALSE)
#shinyjs::useShinyjs()
#yrs <- getAllNlYears("VIIRS")
#isolate({updateTabItems(session, "inputs", "plotNightLights")})
######################## actionButton btnGo ###################################
output$btnGo <- shiny::renderUI({
if(values$needsDataUpdate)
shiny::actionButton("btnGo", "LOAD", style="background-color:orange")
else
shiny::actionButton("btnGo", "LOAD", style="background-color:lightblue")
})
######################## renderUI countries ###################################
output$countries <- shiny::renderUI({
shiny::selectizeInput(inputId = "countries",
label = "Select Country(ies)",
choices = ctryCodesWithData(),
multiple = TRUE
)
})
######################## renderUI polySrc ###################################
output$polySrc <- shiny::renderUI({
if(is.null(input$countries))
return()
polySrcs <- Rnightlights::listCtryNlData(ctryCode=input$countries)$polySrc
shiny::selectInput(inputId = "polySrc", label = "polySrc", choices = polySrcs)
})
######################## renderUI polyVer ###################################
output$polyVer <- shiny::renderUI({
if(is.null(input$countries) || is.null(input$polySrc))
return()
polyVers <- Rnightlights::listCtryNlData(ctryCode=input$countries, polySrcs = input$polySrc)$polyVer
shiny::selectInput(inputId = "polyVer", label = "polyVer", choices = polyVers)
})
######################## renderUI polySrc ###################################
output$polyType <- shiny::renderUI({
if(is.null(input$countries) || is.null(input$polySrc))
return()
polyTypes <- Rnightlights::listCtryNlData(ctryCode=input$countries)$polyType
shiny::selectInput(inputId = "polyType", label = "polyType", choices = polyTypes)
})
######################## reactive ctryCodesWithData ###################################
ctryCodesWithData <- shiny::reactive({
existingData <- Rnightlights::listCtryNlData()
ctryCodesWithData <- unique(existingData$ctryCode)
ctryCodeNames <- lapply(ctryCodesWithData, function(x) Rnightlights::ctryCodeToName(x))
ctryCodeNames[is.na(ctryCodeNames)] <- "---"
ctryCodesWithData <- stats::setNames(ctryCodesWithData, ctryCodeNames)
ctryCodesWithData
})
######################## reactive getInputCountries ###########################
getInputCountries <- reactive({
countries <- input$countries
countries[countries=="---" | countries==" "] <- ""
countries
})
######################## reactive ctryAdmLevels ###################################
ctryAdmLevels <- shiny::reactive({
#print(paste0("here: ctryAdmLevels"))
countries <- getInputCountries()
if(length(countries) > 1)
return()
polySrc <- input$polySrc
polyVer <- input$polyVer
polyType <- input$polyType
if((length(countries) == 0 || countries == ""))
if(is.null(polySrc) || polySrc == "" || polySrc == "GADM" || is.null(polyVer) || polyVer == "")
return()
if(!(length(countries) == 0 || countries == ""))
if(is.null(polySrc) || polySrc == "" || is.null(polyVer) || polyVer == "")
return()
custPolyPath <- if(polySrc == "CUST") polyVer else NULL
admLevelNames <- Rnightlights:::getCtryStructAdmLevelNames(ctryCode = countries,
gadmVersion = polyVer,
gadmPolyType = polyType,
custPolyPath = custPolyPath)
admLevelNames
})
######################## reactive ctryAdmLevelNames ###################################
ctryAdmLevelNames <- shiny::reactive({
#print(paste0("here: ctryAdmLevelNames"))
countries <- getInputCountries()
if (length(countries) != 1)
return()
polySrc <- input$polySrc
polyVer <- input$polyVer
polyType <- input$polyType
custPolyPath <- if(polySrc == "CUST") polyVer else NULL
ctryStructFile <- Rnightlights:::getCtryStructFnamePath(ctryCode = countries,
gadmVersion = polyVer,
gadmPolyType = polyType,
custPolyPath = custPolyPath)
if(!file.exists(ctryStructFile))
return()
hdr <- data.table::fread(ctryStructFile, nrows = 1, header = T)
colClasses <- names(hdr)
colClasses[-grep("area_sq_km|NL_", colClasses)] <- "character"
colClasses[grep("area_sq_km|NL_", colClasses)] <- "NULL"
data <- data.table::fread(Rnightlights:::getCtryStructFnamePath(ctryCode = countries,
gadmVersion = polyVer,
gadmPolyType = polyType,
custPolyPath = custPolyPath),
colClasses = colClasses, header = T)
})
######################## reactive ctryNlTypes ###################################
ctryNlTypes <- shiny::reactive({
#print(paste0("here: ctryNlTypes"))
countries <- getInputCountries()
polySrc <- input$polySrc
polyVer <- input$polyVer
if ((length(countries) == 0 || grepl("^\\s*$", countries)) && (is.null(polySrc) || polySrc =="" || is.null(polyVer) || polyVer==""))
return()
if(!(length(countries) == 0 || grepl("^\\s*$", countries)))
if(is.null(polySrc) || polySrc =="" || is.null(polyVer) || polyVer=="")
return()
custPolyPath <- if(polySrc == "CUST") polyVer else NULL
nlTypes <- unique(Rnightlights::listCtryNlData(ctryCodes = countries, polySrcs = polySrc, polyVers = polyVer)$nlType)
return(nlTypes)
})
######################## reactive ctryDataStats ###################################
ctryDataStats <- shiny::reactive({
#print(paste0("here: ctryDataStats"))
#print(paste0("here: ctryNlTypes"))
countries <- getInputCountries()
polySrc <- input$polySrc
polyVer <- input$polyVer
polyType <- input$polyType
if ((length(countries) == 0 || grepl("^\\s*$", countries)) && (is.null(polySrc) || polySrc =="" || polySrc == "GADM" || is.null(polyVer) || polyVer==""))
return()
if(is.null(polySrc) || polySrc == "")
return()
if(is.null(polyVer) || polyVer == "")
return()
if(is.null(polyType) || polyType == "")
return()
nlType <- input$nlType
if(is.null(nlType))
return(NULL)
nlStats <- NULL
custPolyPath <- if(polySrc == "CUST") polyVer else NULL
if (length(countries) == 1)
{
admLevel <- selectedAdmLevel()
ctryNlDataFile <- Rnightlights::getCtryNlDataFnamePath(ctryCode = countries,
admLevel = admLevel,
gadmVersion = polyVer,
gadmPolyType = polyType,
custPoly = custPolyPath)
if(file.exists(ctryNlDataFile))
hdrs <- data.table::fread(ctryNlDataFile, nrows = 1, header = T)
else
hdrs <- NULL
cols <- grep(pattern = paste0("NL_", nlType), x = names(hdrs), value = T)
nlStats <- list(unique(gsub(".*._.*._.*._", "", cols)))
}
else if(length(countries) > 1) #remove subcountry admin levels
{
for (ctryCode in countries)
{
admLevel <- paste0(ctryCode, "_adm0")
ctryNlDataFile <- Rnightlights::getCtryNlDataFnamePath(ctryCode = ctryCode,
admLevel = admLevel,
gadmVersion = polyVer,
gadmPolyType = polyType,
custPolyPath = custPolyPath)
if(file.exists(ctryNlDataFile))
hdrs <- data.table::fread(ctryNlDataFile, nrows = 1, header = T)
else
hdrs <- NULL
cols <- grep(pattern = paste0("NL_", nlType), x = names(hdrs), value = T)
temp <- list(unique(gsub(".*._.*._.*._", "", cols)))
nlStats <- c(nlStats, temp)
}
}
if(is.null(nlStats))
return(NULL)
if(length(nlStats) == 1)
nlStats <- unlist(nlStats)
else
nlStats <- unlist(Reduce(intersect, nlStats))
return(nlStats)
})
######################## reactive ctryNlDataLvl2 ###################################
ctryNlDataLvl2 <- shiny::reactive({
#print(paste0("here: ctryNlDataLvl2"))
input$btnGo
countries <- shiny::isolate(getInputCountries())
polySrc <- shiny::isolate(input$polySrc)
polyVer <- shiny::isolate(input$polyVer)
polyType <- shiny::isolate(input$polyType)
nlType <- shiny::isolate(input$nlType)
if (is.null(polySrc) || polySrc=="" || is.null(polyVer) || polyVer=="" || is.null(polyType) || polyType == "")
return(NULL)
if(is.null(nlType))
return(NULL)
ctryData <- NULL
custPolyPath <- if(polySrc == "CUST") polyVer else NULL
if (length(countries) == 1)
{
admLevel <- unlist(Rnightlights:::getCtryShpAllAdmLvls(ctryCodes = countries,
gadmVersion = polyVer,
gadmPolyType = polyType,
custPolyPath = custPolyPath))[2]
if(input$strict)
{
ctryNlDataFile <- Rnightlights::getCtryNlDataFnamePath(ctryCode = countries,
admLevel = admLevel,
gadmVersion = polyVer,
gadmPolyType = polyType,
custPolyPath = custPolyPath)
if(file.exists(ctryNlDataFile))
ctryData <- data.table::fread(ctryNlDataFile)
else
ctryData <- NULL
}
else
{
ctryData <- ctryNlDataMelted()
ctryData <- stats::setNames(ctryData[,list(mean(value, na.rm = TRUE)), by = list(ctryData[[2]], variable)], c(admLevel, "variable", "value"))
}
}
else if(length(countries) > 1) #remove subcountry admin levels
{
for (ctryCode in countries)
{
admLevel <- paste0(ctryCode, "_adm0")
#print(ctryCode)
ctryNlDataFile <- Rnightlights::getCtryNlDataFnamePath(ctryCode = ctryCode,
admLevel = admLevel,
gadmVersion = polyVer,
gadmPolyType = polyType,
custPolyPath = custPolyPath)
if(file.exists(ctryNlDataFile))
temp <- data.table::fread(ctryNlDataFile)
else
temp <- NULL
ctryCols <- grep(paste0("country|area|NL_", nlType), names(temp))
temp <- temp[, ctryCols, with=F]
if (is.null(ctryData))
{
ctryData <- temp
}else
{
ctryData <- merge(ctryData, temp, all=TRUE)
}
}
}
#get the nlType columns
ctryCols <- names(ctryData)
ctryNonNLCols <- grep("NL_", ctryCols, invert = T, value = T)
ctryNLCols <- grep("NL_", ctryCols, value = T)
ctryNLColsNlType <- grep(nlType, ctryNLCols, value = T)
ctryData <- ctryData[, c(ctryNonNLCols, ctryNLColsNlType), with=F]
return(ctryData)
})
######################## reactive ctryNlData ###################################
ctryNlData <- shiny::reactive({
#print(paste0("here: ctryNlData"))
input$btnGo
countries <- shiny::isolate(getInputCountries())
polySrc <- shiny::isolate(input$polySrc)
polyVer <- shiny::isolate(input$polyVer)
polyType <- shiny::isolate(input$polyType)
nlType <- shiny::isolate(input$nlType)
if (is.null(polySrc) || polySrc == "" || is.null(polyVer) || polyVer == "" || is.null(polyType) || polyType == "")
return(NULL)
if(is.null(nlType))
return(NULL)
ctryData <- NULL
custPolyPath <- if(polySrc == "CUST") polyVer else NULL
if (length(countries) == 1)
{
lyrNum <- which(unlist(ctryAdmLevels()) == shiny::isolate(input$admLevel))-1
admLevel <- unlist(Rnightlights:::getCtryShpLyrNames(ctryCodes = countries,
lyrNums = lyrNum,
gadmVersion = polyVer,
gadmPolyType = polyType,
custPolyPath = custPolyPath))
if(input$strict)
{
ctryNlDataFile <- Rnightlights::getCtryNlDataFnamePath(ctryCode = countries,
admLevel = admLevel,
gadmVersion = polyVer,
gadmPolyType = polyType,
custPolyPath = custPolyPath)
if(file.exists(ctryNlDataFile))
ctryData <- data.table::fread(ctryNlDataFile)
}
else
{
lyrNum <- Rnightlights:::ctryShpLyrName2Num(ctryCode = countries,
layerName = Rnightlights:::getCtryShpLowestLyrNames(ctryCodes = countries,
gadmVersion = polyVer,
gadmPolyType = polyType,
custPolyPath = custPolyPath),
gadmVersion = polyVer,
gadmPolyType = polyType)
while(lyrNum > 0 && is.null(ctryData))
{
admLevel <- Rnightlights:::getCtryShpLyrNames(ctryCodes = countries,
lyrNums = lyrNum,
gadmVersion = polyVer,
gadmPolyType = polyType,
custPolyPath = custPolyPath)
ctryNlDataFile <- Rnightlights::getCtryNlDataFnamePath(ctryCode = countries,
admLevel = admLevel,
gadmVersion = polyVer,
gadmPolyType = polyType,
custPolyPath = custPolyPath)
if(file.exists(ctryNlDataFile))
ctryData <- data.table::fread(ctryNlDataFile)
lyrNum <- lyrNum - 1
}
}
}
else if(length(countries) > 1) #remove subcountry admin levels
{
for (ctryCode in countries)
{
admLevel <- paste0(ctryCode, "_adm0")
#print(ctryCode)
ctryNlDataFile <- Rnightlights::getCtryNlDataFnamePath(ctryCode = ctryCode,
admLevel = admLevel,
gadmVersion = polyVer,
gadmPolyType = polyType,
custPolyPath = custPolyPath)
if(file.exists(ctryNlDataFile))
temp <- data.table::fread(ctryNlDataFile)
else
temp <- NULL
ctryCols <- grep(paste0("country|area|NL_", nlType), names(temp))
temp <- temp[, ctryCols, with=F]
if (is.null(ctryData))
{
ctryData <- temp
}else
{
ctryData <- merge(ctryData, temp, all=TRUE)
}
}
}
#get the nlType columns
ctryCols <- names(ctryData)
ctryNonNLCols <- grep("NL_", ctryCols, invert = T, value = T)
ctryNLCols <- grep("NL_", ctryCols, value = T)
ctryNLColsNlType <- grep(nlType, ctryNLCols, value = T)
ctryData <- ctryData[, c(ctryNonNLCols, ctryNLColsNlType), with=F]
return(ctryData)
})
######################## reactive ctryNlDataMelted ###################################
ctryNlDataMelted <- shiny::reactive({
#print(paste0("here: ctryNlDataMelted"))
ctryData <- ctryNlData()
ctryStat <- input$ctryStat
if(is.null(ctryData))
return()
if(is.null(ctryStat))
return()
shiny::isolate({
#the nightlight cols
nlCols <- names(ctryData)[grep("NL_", names(ctryData))]
#the cols with the stats we want
statCols <- names(ctryData)[grep(paste0("NL_.*.", ctryStat), names(ctryData))]
#the non nightlight cols
ctryDataCols <- setdiff(names(ctryData), nlCols)
#the cols to melt by
meltMeasureVars <- statCols
#combine the non-nightlight cols and the cols with the stats we want
ctryData <- subset(ctryData, select=c(ctryDataCols, meltMeasureVars))
#remove non-digits to get only stat cols
meltVarNames <- gsub("[^[:digit:]]", "", meltMeasureVars)
ctryData <- data.table::data.table(reshape2::melt(ctryData, measure.vars=meltMeasureVars))
if(stringr::str_detect(input$nlType, "OLS"))
{
ctryData$variable <- paste0(gsub("[^[:digit:]]","", ctryData$variable))
ctryData$variable <- as.numeric(ctryData$variable)
}
else if(stringr::str_detect(input$nlType, "VIIRS"))
{
if(stringr::str_detect(input$nlType, "M"))
ctryData$variable <- paste0(gsub("[^[:digit:]]","", ctryData$variable),"01")
else if(stringr::str_detect(input$nlType, "Y"))
ctryData$variable <- paste0(gsub("[^[:digit:]]","", ctryData$variable),"0101")
ctryData$variable <- as.Date(ctryData$variable, format="%Y%m%d")
}
return(ctryData)
})
})
######################## reactive ctryNlDataMeltedLvl2 ###################################
ctryNlDataMeltedLvl2 <- shiny::reactive({
#print(paste0("here: ctryNlDataMelted"))
ctryData <- ctryNlDataLvl2()
if(is.null(ctryData))
return()
if(is.null(input$ctryStat))
return()
#the nightlight cols
nlCols <- names(ctryData)[grep("NL_", names(ctryData))]
#the cols with the stats we want
statCols <- names(ctryData)[grep(paste0("NL_.*.", input$ctryStat), names(ctryData))]
#the non nightlight cols
ctryDataCols <- setdiff(names(ctryData), nlCols)
#the cols to melt by
meltMeasureVars <- statCols
#combine the non-nightlight cols and the cols with the stats we want
ctryData <- subset(ctryData, select=c(ctryDataCols, meltMeasureVars))
#remove non-digits to get only stat cols
meltVarNames <- gsub("[^[:digit:]]", "", meltMeasureVars)
ctryData <- data.table::data.table(reshape2::melt(ctryData, measure.vars=meltMeasureVars))
if(stringr::str_detect(input$nlType, "OLS"))
{
ctryData$variable <- paste0(gsub("[^[:digit:]]","", ctryData$variable))
ctryData$variable <- as.numeric(ctryData$variable)
}
else if(stringr::str_detect(input$nlType, "VIIRS"))
{
if(stringr::str_detect(input$nlType, "M"))
ctryData$variable <- paste0(gsub("[^[:digit:]]","", ctryData$variable),"01")
else if(stringr::str_detect(input$nlType, "Y"))
ctryData$variable <- paste0(gsub("[^[:digit:]]","", ctryData$variable),"0101")
ctryData$variable <- as.Date(ctryData$variable, format="%Y%m%d")
}
return(ctryData)
})
######################## renderUI ctryStats ###################################
output$ctryStats <- shiny::renderUI({
# if(length(input$countries) != 1)
# return()
polySrc <- input$polySrc
polyVer <- input$polyVer
nlType <- input$nlType
if(is.null(polySrc) || polySrc=="" || is.null(polyVer) || polyVer=="" || is.null(nlType))
return()
ctryDtStats <- ctryDataStats()
if(length(ctryDtStats)==0)
return(NULL)
if(!is.null(input$ctryStat))
chosenStat <- input$ctryStat
else
chosenStat <- NULL
shiny::radioButtons(inputId = "ctryStat",
label = "Stats",
choices = ctryDtStats,
inline = TRUE,
selected = chosenStat
)
})
######################## renderUI nlType ###################################
output$nlType <- shiny::renderUI({
countries <- getInputCountries()
if(length(countries) == 0 || countries=="")
return()
nlTypes <- ctryNlTypes()
if(is.null(nlTypes))
return(NULL)
if(!is.null(input$nlType))
chosenNlType <- input$nlType
else
chosenNlType <- NULL
shiny::radioButtons(inputId = "nlType",
label = "NL Type",
choices = nlTypes,
selected = chosenNlType,
inline = TRUE
)
})
######################## reactiveValues values ###################################
values <- shiny::reactiveValues(
lastUpdated = NULL,
needsDataUpdate = FALSE
)
######################## observe lastUpdated ###################################
observe({
lapply(names(input), function(x) {
shiny::observe({
input[[x]]
values$lastUpdated <- x
})
})
})
# observe({
# if(length(input$countries) != 1)
# return()
#
# admLvlCtrlNames <- names(input)
#
# selectAdmLvls <- admLvlCtrlNames[grep("selectAdm", admLvlCtrlNames)]
#
# if(length(selectAdmLvls) > 0)
# lapply(selectAdmLvls, function(selectAdmLvl){
# lyrNum <- as.numeric(gsub("[^[:digit:]]", "", selectAdmLvl))-1
#
# admLevel <- unlist(Rnightlights:::getCtryShpLyrNames(input$countries, lyrNum))
#
# ctryNlDataFile <- Rnightlights::getCtryNlDataFnamePath(input$countries, admLevel)
#
# if(!file.exists(ctryNlDataFile))
# shinyjs::disable(selectAdmLvl)
# })
# })
observeEvent(input$nlType, {
values$needsDataUpdate <- TRUE
})
observeEvent(input$countries, {
values$needsDataUpdate <- TRUE
})
observeEvent(input$polySrc, {
values$needsDataUpdate <- TRUE
})
observeEvent(input$polyVer, {
values$needsDataUpdate <- TRUE
})
observeEvent(input$btnGo, {
values$needsDataUpdate <- FALSE
})
######################## renderUI intraCountry1 ###################################
output$intraCountry1 <- shiny::renderUI({
countries <- getInputCountries()
polySrc <- input$polySrc
polyVer <- input$polyVer
polyType <- input$polyType
if(length(countries) != 1 || is.null(polySrc) || is.null(polyVer))
return()
custPolyPath <- if(polySrc == "CUST") polyVer else NULL
admLevels <- unlist(ctryAdmLevels())
if(is.null(admLevels))
return()
if(input$strict)
admLevels <- unlist(sapply(1:length(admLevels), function(admLevel)
{
ctryNlDataFile <-
Rnightlights::getCtryNlDataFnamePath(ctryCode = countries,
admLevel = Rnightlights:::getCtryShpLyrNames(
ctryCode = countries,
lyrNums = admLevel-1,
gadmVersion = polyVer,
gadmPolyType = polyType,
custPolyPath = custPolyPath),
gadmVersion = polyVer,
gadmPolyType = polyType,
custPolyPath = custPolyPath)
if(file.exists(ctryNlDataFile))
return(admLevels[admLevel])
else
return(paste0(admLevels[admLevel], " (NA)"))
}))
shiny::radioButtons(inputId = "admLevel",
label = "Admin Level",
choiceNames = admLevels,
choiceValues = gsub("\\s*\\(NA\\)", "", admLevels)
)
})
######################## render UI: intraCountry ###################################
tags$head(tags$style(HTML("div.form-group.shiny-input-container {margin-top: -20px; margin-bottom: -20px;}")))
output$intraCountry <- shiny::renderUI({
#print("here: renderUI intracountry")
countries <- getInputCountries()
polySrc <- input$polySrc
polyVer <- input$polyVer
if(length(countries) != 1 || identical(countries, character(0)))
return()
if((length(countries) != 1 || identical(countries, character(0)) || grepl("^\\s*$", countries)) && (is.null(polySrc) || polySrc=="" || is.null(polyVer) || polyVer==""))
return()
ctryAdmLevels <- unlist(ctryAdmLevels())
if(is.null(ctryAdmLevels))
return()
ctryAdmLevelNames <- ctryAdmLevelNames()
if (length(ctryAdmLevelNames)>1)
elems <- lapply(2:length(ctryAdmLevels), function(lvlIdx){
lvl <- ctryAdmLevels[lvlIdx]
if(input$strict)
lvlEnabled <- file.exists(Rnightlights::getCtryNlDataFnamePath(countries, paste(getInputCountries(), "_adm", lvlIdx-1, sep = "")))
else
lvlEnabled <- TRUE
#lvlSelect <- unique(ctryAdmLevelNames[[ctryAdmLevels[lvlIdx]]])
lvlSelect <- unique(dplyr::select(ctryAdmLevelNames, lvlIdx-1,lvlIdx))
lvlSelect <- group_by(lvlSelect, ctryAdmLevels[lvlIdx-1])
lvlSelect <- split(lvlSelect[[ctryAdmLevels[lvlIdx]]], lvlSelect[[ctryAdmLevels[lvlIdx-1]]])
names(lvlSelect) <- paste(ctryAdmLevels[lvlIdx-1], names(lvlSelect), sep = ":")
if(!lvlEnabled)
lvlSelect <- NULL
if(lvlEnabled)
{
b <- shiny::selectizeInput(inputId = paste0("selectAdm", lvlIdx),
label = ctryAdmLevels[lvlIdx],
#choices = NULL,
choices = lvlSelect,
multiple = TRUE
)
}else
{
b <- shiny::textInput(inputId = "dummy",
label = ctryAdmLevels[lvlIdx],
value = "Strict: Data Not Available",
placeholder = "Disable Strict to aggregate data")
}
b
})
})
######################## selectedAdmLevel ###################################
selectedAdmLevel <- shiny::reactive({
if(length(getInputCountries()) > 1 || length(getInputCountries()) == 0)
return()
admLvlCtrlNames <- names(input)
x <- admLvlCtrlNames[grep("selectAdm", admLvlCtrlNames)]
if(length(x) == 0)
return()
#return(paste0(getInputCountries(), "_adm0"))
admLvlNums <- NULL
for (i in x)
if(length(input[[i]])>0)
admLvlNums <- c(admLvlNums, i)
#print(paste0("x", x))
#print(paste0("admlvlnums:", admLvlNums))
#if (admLvlNum=="" && length(countries)>0)
# return()
admLvlNums <- as.numeric(gsub("[^[:digit:]]","",admLvlNums))
if (length(admLvlNums)==0)
admLvlNums <- 1
admLvlNums <- admLvlNums - 1
admLevel <- paste0(getInputCountries(), "_adm",data.table::last(admLvlNums))
admLevel
})
######################## observe selectAdms (intraCountry) ###################################
shiny::observe({
#print(paste0("here: observe selectAdms"))
admLvlCtrlsNames <- names(input)
x <- admLvlCtrlsNames[grep("selectAdm", admLvlCtrlsNames)]
if(length(x)==0)
return()
admSelected <- FALSE
lowestSelected <- ""
for (i in x)
{
if (length(input[[i]]) > 0)
{
admSelected <- TRUE
lowestSelected <- gsub("[^[:digit:]]","",i)
}
}
if (!admSelected)
return()
ctryAdmLevelNames <- ctryAdmLevelNames()
ctryAdmLevelNamesFilter <- ctryAdmLevelNames
ctryAdmLevels <- unlist(ctryAdmLevels())
lvlNum <- gsub("[^[:digit:]]", "",values$lastUpdated) #gsub("[^[:digit:]]", "", x)
if(lvlNum=="")
return()
#print(paste0("lastupdated:", values$lastUpdated))
#print(paste0("x:", x))
#print(paste0("lvlnum:", lvlNum))
#set admLevel to match the selectizeInput level
#if (length(input[[paste0("selectAdm", lvlNum)]]) > 0)
updateRadioButtons(session = session, inputId = "admLevel", selected = ctryAdmLevels[as.numeric(lowestSelected)])
multipleSelected <- FALSE
for (lvlIdx in 2:length(ctryAdmLevels))
{
lvlSelect <- ""
top10 <- ""
if(input$strict)
lvlEnabled <- file.exists(Rnightlights::getCtryNlDataFnamePath(getInputCountries(), Rnightlights:::getCtryShpLyrNames(getInputCountries(), lvlIdx-1)))
else
lvlEnabled <- TRUE
if (length(input[[paste0("selectAdm", lvlIdx)]]) > 1)
multipleSelected <- TRUE
if (lvlIdx < lvlNum)
{
#print(paste0("lvlIdx:",lvlIdx,"lvlNum:",lvlNum))
if (length(input[[paste0("selectAdm", lvlIdx-1)]]) == 1)
{
ctryAdmLevelNamesFilter <- subset(ctryAdmLevelNamesFilter,ctryAdmLevelNamesFilter[[ctryAdmLevels[[lvlIdx-1]]]]==input[[paste0("selectAdm", lvlIdx-1)]])
#lvlSelect <- unique(ctryAdmLevelNamesFilter[[ctryAdmLevels[lvlIdx]]])
lvlSelect <- unique(dplyr::select(ctryAdmLevelNamesFilter, lvlIdx-1,lvlIdx))
lvlSelect <- group_by(lvlSelect, ctryAdmLevels[lvlIdx-1])
lvlSelect <- split(lvlSelect[[ctryAdmLevels[lvlIdx]]], lvlSelect[[ctryAdmLevels[lvlIdx-1]]])
names(lvlSelect) <- paste(ctryAdmLevels[lvlIdx-1], names(lvlSelect), sep = ":")
}
else
{
#lvlSelect <- unique(ctryAdmLevelNamesFilter[[ctryAdmLevels[lvlIdx]]])
lvlSelect <- unique(dplyr::select(ctryAdmLevelNamesFilter, lvlIdx-1,lvlIdx))
lvlSelect <- group_by(lvlSelect, ctryAdmLevels[lvlIdx-1])
lvlSelect <- split(lvlSelect[[ctryAdmLevels[lvlIdx]]], lvlSelect[[ctryAdmLevels[lvlIdx-1]]])
names(lvlSelect) <- paste(ctryAdmLevels[lvlIdx-1], names(lvlSelect), sep=":")
}
#print(paste0("lvlSelect:",lvlSelect))
#print(paste0("lvlselect: ", lvlSelect))
#print(paste0("top10: ", top10))
#updateCheckboxInput(session, paste0("radioAdm", lvlIdx),value = TRUE)
if(!lvlEnabled)
lvlSelect <- NULL
shiny::updateSelectInput(session, paste0("selectAdm",lvlIdx), choices = lvlSelect, selected = input[[paste0("selectAdm",lvlIdx)]])
}
else if(lvlIdx == lvlNum)
{
#print(paste0("lvlIdx:",lvlIdx,"lvlNum:",lvlNum))
if (length(input[[paste0("selectAdm", lvlIdx-1)]]) == 1)
{
ctryAdmLevelNamesFilter <- subset(ctryAdmLevelNamesFilter,ctryAdmLevelNamesFilter[[ctryAdmLevels[[lvlIdx-1]]]]==input[[paste0("selectAdm", lvlIdx-1)]])
#lvlSelect <- unique(ctryAdmLevelNamesFilter[[ctryAdmLevels[lvlIdx]]])
lvlSelect <- unique(dplyr::select(ctryAdmLevelNamesFilter, lvlIdx-1,lvlIdx))
lvlSelect <- group_by(lvlSelect, ctryAdmLevels[lvlIdx-1])
lvlSelect <- split(lvlSelect[[ctryAdmLevels[lvlIdx]]], lvlSelect[[ctryAdmLevels[lvlIdx-1]]])
names(lvlSelect) <- paste(ctryAdmLevels[lvlIdx-1], names(lvlSelect), sep=":")
#top10 <- if(length(lvlSelect) > 1) lvlSelect[1] else no = lvlSelect
#print(paste0("lvlselect: ", lvlSelect))
#print(paste0("top10: ", top10))
#updateCheckboxInput(session, paste0("radioAdm", lvlIdx),value = TRUE)
if(!lvlEnabled)
lvlSelect <- NULL
# if (length(input[[paste0("radioAdm", lvlIdx)]])==0)
shiny::updateSelectizeInput(session, paste0("selectAdm",lvlIdx), choices = lvlSelect, selected = input[[paste0("selectAdm",lvlIdx)]])
}else
{
shiny::updateSelectizeInput(session, paste0("selectAdm", lvlIdx), choices = NULL)
}
}
else
{
#print(paste0("lvlIdx:",lvlIdx,"lvlNum:",lvlNum))
# if (multipleSelected)
# {
# shiny::updateSelectizeInput(session, paste0("selectAdm", lvlIdx), choices = "")
# next()
# }
if(length(input[[paste0("selectAdm",lvlIdx-1)]]) == 1)
{
ctryAdmLevelNamesFilter <- subset(ctryAdmLevelNamesFilter,ctryAdmLevelNamesFilter[[ctryAdmLevels[[lvlIdx-1]]]]==input[[paste0("selectAdm", lvlIdx-1)]])
#lvlSelect <- unique(ctryAdmLevelNamesFilter[[ctryAdmLevels[lvlIdx]]])
lvlSelect <- unique(dplyr::select(ctryAdmLevelNamesFilter, lvlIdx-1,lvlIdx))
lvlSelect <- group_by(lvlSelect, ctryAdmLevels[lvlIdx-1])
lvlSelect <- split(lvlSelect[[ctryAdmLevels[lvlIdx]]], lvlSelect[[ctryAdmLevels[lvlIdx-1]]])
names(lvlSelect) <- paste(ctryAdmLevels[lvlIdx-1], names(lvlSelect), sep=":")
#updateCheckboxInput(session, paste0("radioAdm", lvlIdx),value = FALSE)
if(!lvlEnabled)
lvlSelect <- NULL
shiny::updateSelectizeInput(session, paste0("selectAdm", lvlIdx), choices = lvlSelect)
}
else if(length(input[[paste0("selectAdm",lvlIdx-1)]]) == 0 && length(input[[paste0("selectAdm", lvlNum)]])==1)
{
#lvlSelect <- unique(ctryAdmLevelNamesFilter[[ctryAdmLevels[lvlIdx]]])
lvlSelect <- unique(dplyr::select(ctryAdmLevelNamesFilter, lvlIdx-1,lvlIdx))
lvlSelect <- group_by(lvlSelect, ctryAdmLevels[lvlIdx-1])
lvlSelect <- split(lvlSelect[[ctryAdmLevels[lvlIdx]]], lvlSelect[[ctryAdmLevels[lvlIdx-1]]])
names(lvlSelect) <- paste(ctryAdmLevels[lvlIdx-1], names(lvlSelect), sep=":")
if(!lvlEnabled)
lvlSelect <- NULL
shiny::updateSelectizeInput(session, paste0("selectAdm", lvlIdx), choices = lvlSelect)
}
else
{
##lvlSelect <- unique(ctryAdmLevelNamesFilter[[ctryAdmLevels[lvlIdx]]])
#lvlSelect <- unique(dplyr::select(ctryAdmLevelNamesFilter, lvlIdx-1,lvlIdx))
#lvlSelect <- group_by(lvlSelect, ctryAdmLevels[lvlIdx-1])
#lvlSelect <- split(lvlSelect[[ctryAdmLevels[lvlIdx]]], lvlSelect[[ctryAdmLevels[lvlIdx-1]]])
#shiny::updateSelectizeInput(session, paste0("selectAdm", lvlIdx), choices = lvlSelect, selected = NULL)
if(length(input[[paste0("selectAdm", lvlIdx-1)]]) > 0)
ctryAdmLevelNamesFilter <- subset(ctryAdmLevelNamesFilter,ctryAdmLevelNamesFilter[[ctryAdmLevels[[lvlIdx-1]]]] %in% input[[paste0("selectAdm", lvlIdx-1)]])
#lvlSelect <- unique(ctryAdmLevelNamesFilter[[ctryAdmLevels[lvlIdx]]])
lvlSelect <- unique(dplyr::select(ctryAdmLevelNamesFilter, lvlIdx-1,lvlIdx))
lvlSelect <- group_by(lvlSelect, ctryAdmLevels[lvlIdx-1])
lvlSelect <- split(lvlSelect[[ctryAdmLevels[lvlIdx]]], lvlSelect[[ctryAdmLevels[lvlIdx-1]]])
names(lvlSelect) <- paste(ctryAdmLevels[lvlIdx-1], names(lvlSelect), sep = ":")
#updateCheckboxInput(session, paste0("radioAdm", lvlIdx),value = FALSE)
if(!lvlEnabled)
lvlSelect <- NULL
shiny::updateSelectizeInput(session, paste0("selectAdm", lvlIdx), choices = lvlSelect)
}
}
# if(!lvlEnabled)
# {
# shinyjs::disable(selector = paste0("[type=radio][value=selectAdm", lvlIdx,"]"))
#
# shinyjs::disable(paste0("selectAdm", lvlIdx))
#
# shinyjs::runjs(paste0("$('selectAdm", lvlIdx, "').parent().parent().addClass('disabled').css('opacity', 0.4)"))
# }
}
#})
})
#})
######################## sliderNlPeriodRange ###################################
output$sliderNlPeriodRange <- shiny::renderUI({
#print(paste0("here: sliderNlPeriodRange"))
ctryData <- ctryNlDataMelted()
shiny::isolate({
if (is.null(ctryData))
{
nlRangeStart <- NULL
nlRangeEnd <- NULL
return()
# shiny::sliderInput(inputId = "nlPeriodRange",
# label = "Time",
# min = as.Date("2012-04-01", "%Y-%m-%d"),
# max = as.Date("2017-10-31", "%Y-%m-%d"),
# timeFormat = "%Y-%m",
# step = 31,
# value = c(as.Date("2012-04-01","%Y-%m-%d"),as.Date("2017-10-31","%Y-%m-%d"))
# )
}
else
{
minDate <- min(ctryData$variable)
maxDate <- max(ctryData$variable)
startDate <- minDate
endDate <- maxDate
if(stringr::str_detect(input$nlType, "D"))
{
tmFmt <- "%Y-%m-%d"
if(!is.null(input$nlPeriodRange))
{
nlRangeStart <- as.Date(as.character(input$nlPeriodRange[1]), tmFmt)
nlRangeEnd <- as.Date(as.character(input$nlPeriodRange[2]), tmFmt)
}
step <- 1
}else if(stringr::str_detect(input$nlType, "M"))
{
tmFmt <- "%Y-%m"
if(!is.null(input$nlPeriodRange))
{
nlRangeStart <- as.Date(as.character(input$nlPeriodRange[1]), tmFmt)
nlRangeEnd <- as.Date(as.character(input$nlPeriodRange[2]), tmFmt)
}
step <- 31
}else if(stringr::str_detect(input$nlType, "Y"))
{
tmFmt <- "%Y"
if(!is.null(input$nlPeriodRange))
{
nlRangeStart <- lubridate::year(as.Date(as.character(input$nlPeriodRange[1]), tmFmt))
nlRangeEnd <- lubridate::year(as.Date(as.character(input$nlPeriodRange[2]), tmFmt))
}
step <- 1
}
if(!is.null(input$nlPeriodRange))
{
if(is.na(nlRangeStart))
{
nlRangeStart <- minDate
nlRangeEnd <- maxDate
}
if(nlRangeStart > minDate)
startDate <- nlRangeStart
if(nlRangeEnd < maxDate)
endDate <- nlRangeEnd
}
shiny::sliderInput(inputId = "nlPeriodRange",
label = "Time",
min = minDate,
max = maxDate,
timeFormat = tmFmt,
step = step,
value = c(startDate, endDate),
animate = animationOptions(interval = 1000, loop = FALSE, playButton = NULL, pauseButton = NULL)
)
}
})
})
######################## sliderNlPeriod ###################################
output$sliderNlPeriod <- shiny::renderUI({
#print(paste0("here: sliderNlPeriod"))
ctryData <- ctryNlDataMelted()
shiny::isolate({
if (is.null(ctryData))
{
shiny::sliderInput(inputId = "nlPeriod",
label = "Time",
min = as.Date("2012-04-01", "%Y-%m-%d"),
max = as.Date("2017-10-31", "%Y-%m-%d"),
timeFormat = "%Y-%m",
step = 31,
value = as.Date("2012-04-01", "%Y-%m-%d")
)
}
else
{
minDate <- min(ctryData$variable)
maxDate <- max(ctryData$variable)
if(stringr::str_detect(input$nlType, "D"))
{
tmFmt <- "%Y-%m-%d"
if(!is.null(input$nlPeriod))
{
value <- as.Date(as.character(input$nlPeriod), tmFmt)
}
step <- 1
}
else if(stringr::str_detect(input$nlType, "M"))
{
tmFmt <- "%Y-%m"
if(!is.null(input$nlPeriod))
{
value <- as.Date(as.character(input$nlPeriod), tmFmt)
}
step <- 31
}
else if(stringr::str_detect(input$nlType, "Y"))
{
tmFmt <- "%Y"
if(!is.null(input$nlPeriod))
{
value <- lubridate::year(as.Date(as.character(input$nlPeriod), tmFmt))
}
step <- 1
}
if(!is.null(input$nlPeriod))
value <- as.Date(as.character(input$nlPeriod), tmFmt)
else
value <- minDate
shiny::sliderInput(inputId = "nlPeriod",
label = "Time",
min = minDate,
max = maxDate,
timeFormat = tmFmt,
step = step,
value = value,
animate = animationOptions(interval = 1000, loop = FALSE, playButton = "Play", pauseButton = NULL)
)
}
})
})
######################## hCluster ###################################
hCluster <- shiny::reactive({
print(paste0("here: reactive hCluster"))
input$btnGo
countries <- shiny::isolate(getInputCountries())
if (is.null(countries) || length(countries) > 1)
return()
scale <- input$scale
normArea <- input$norm_area
shiny::isolate({
nlPeriodRange <- input$nlPeriodRange
graphType <- input$graphType
admLevel <- unlist(ctryAdmLevels())[2]
#return if the country doesn't have adm levels below country
if (is.null(admLevel) || is.na(admLevel))
return()
#meltCtryData <- ctryNlDataMelted()
meltCtryData <- ctryNlDataMeltedLvl2()
if (is.null(countries) || is.null(meltCtryData))
return()
if (normArea)
meltCtryData$value <- (meltCtryData$value)/meltCtryData$area_sq_km
#aggMeltCtryData <- stats::aggregate(mean(value), by=list(eval(admLevel)+variable), data=meltCtryData, mean)
aggMeltCtryData <- stats::setNames(meltCtryData[,list(mean(value, na.rm = TRUE)), by = list(meltCtryData[[make.names(admLevel)]], variable)], c(admLevel, "variable", "value"))
dcastFormula <- paste(paste0("`", admLevel, "`", collapse = " + "), "~", paste("variable", collapse = " + "))
unmeltCtryData <- data.table::dcast(aggMeltCtryData, dcastFormula, value.var='value', aggregate='mean')
d <- stats::dist(unmeltCtryData)
h <- stats::hclust(d)
h$labels <- unmeltCtryData[[make.names(admLevel)]]
h
})
})
######################## plotHCluster ###################################
output$plotHCluster <- shiny::renderPlot({
#print(paste0("here: plotHCluster"))
clusts <- hCluster()
numClusters <- input$kClusters
if (is.null(clusts))
return("Country has no adm levels")
shiny::isolate({
dendro <- stats::as.dendrogram(clusts)
cbPalette <- c("#999999", "#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7")
dendro %>% dendextend::color_branches(k=numClusters, col = cbPalette) %>%
dendextend::color_labels(k=numClusters, col = cbPalette) %>%
graphics::plot(horiz=FALSE, main = "")
dendro %>% dendextend::rect.dendrogram(k=numClusters,horiz=FALSE,border = cbPalette)
})
})
######################## plotPointsCluster ###################################
output$plotPointsCluster <- plotly::renderPlotly({
#print(paste0("here: plotPointsCluster"))
input$btnGo
countries <- shiny::isolate(getInputCountries())
if(length(countries) < 1)
return()
clusts <- hCluster()
if(is.null(clusts))
return()
normArea <- input$norm_area
admLevel <- unlist(ctryAdmLevels())[2]
#return if the country doesn't have adm levels below country
if (admLevel == "")
return()
numClusters <- input$kClusters
scale <- input$scale
isolate({
meltCtryData <- ctryNlDataMeltedLvl2()
if (normArea)
meltCtryData$value <- (meltCtryData$value)/meltCtryData$area_sq_km
cutClusts <- stats::cutree(clusts, k=numClusters)
#ctryAvg <- aggregate(value ~ admLevel, data=meltCtryData, mean)
ctryAvg <- stats::setNames(meltCtryData[,mean(value, na.rm = TRUE), by = list(meltCtryData[[make.names(admLevel)]])], c(admLevel, "value"))
cbPalette <- c("#999999", "#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7")
clusters = as.factor(cutClusts)
g <- ggplot2::ggplot(data=ctryAvg,
aes(x=ctryAvg[[admLevel]],
y=value, col=clusters
)) +
geom_point(size=2) +
theme(axis.text.x=element_text(angle=90,hjust=1,vjust=0.5)) +
ggplot2::scale_colour_manual(values=cbPalette) +
xlab(admLevel) +
ylab("Radiance")
p <- plotly::ggplotly(g)
p$elementId <- NULL
p
})
})
######################## mapHCluster ###################################
output$mapHCluster <- leaflet::renderLeaflet({
print(paste0("here: draw mapHCluster"))
# Use leaflet() here, and only include aspects of the map that
# won't need to change dynamically (at least, not unless the
# entire map is being torn down and recreated).
input$btnGo
countries <- shiny::isolate(getInputCountries())
scale <- input$scale
numClusters <- input$kClusters
normArea <- input$norm_area
shiny::isolate({
if (is.null(countries))
return()
if (length(countries) != 1)
{
renderText("Please select only one country/region")
return()
}
#print("drawing leaflet cluster")
clusts <- hCluster()
cutClusts <- stats::cutree(clusts, k=numClusters)
admLevel <- unlist(ctryAdmLevels())[2]
meltCtryData <- ctryNlDataMeltedLvl2()
if (normArea)
meltCtryData$value <- (meltCtryData$value)/meltCtryData$area_sq_km
ctryPoly0 <- Rnightlights::readCtryPolyAdmLayer(countries, unlist(Rnightlights::getCtryShpLyrNames(countries,0)))
#map <- leaflet::leaflet(data=ctryPoly0) %>%
map <- leaflet::leaflet() %>%
#addTiles("http://a.basemaps.cartocdn.com/dark_all/{z}/{x}/{y}.png") %>%
leaflet::addTiles() %>%
#leaflet::addWMSTiles(layerId="nlRaster", baseUrl = "http://localhost/cgi-bin/mapserv?map=nightlights_wms.map", layers = "nightlights_201401", options = leaflet::WMSTileOptions(format = "image/png", transparent = TRUE, opacity=1)) %>%
leaflet::addPolygons(data=ctryPoly0, layerId = countries, fill = FALSE, fillColor = "#fefe40", stroke = TRUE, weight=4, smoothFactor = 0.7, opacity = 1, color="white", dashArray = "5", group = "country")
lvlCtryData <- stats::setNames(meltCtryData[,mean(value, na.rm = TRUE), by = list(meltCtryData[[make.names(admLevel)]])], c(admLevel, "value"))
lvlCtryData[["rank"]] <- with(lvlCtryData, rank(-value, ties.method = 'first'))
cbPalette <- c("#999999", "#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7")
pal <- cbPalette
#turn off previous layer? No point keeping it if it is hidden. Also we want to turn the current layer to transparent so that one can see through to the raster layer on hover
ctryPoly <- Rnightlights::readCtryPolyAdmLayer(countries, unlist(Rnightlights::getCtryShpLyrNames(countries, 1)))
ctryPoly <- sp::spTransform(ctryPoly, wgs84)
mapLabels <- sprintf(
paste0("%s:%s", "<br/>Cluster: %s", "<br/>Rad:%s", "<br/>Rank: %s/%s"),
admLevel, lvlCtryData[[1]], cutClusts, format(lvlCtryData[[2]],scientific = T,digits = 2), lvlCtryData[["rank"]], nrow(lvlCtryData)
) %>% lapply(htmltools::HTML)
map <- map %>% leaflet::addPolygons(
data = ctryPoly,
layerId = as.character(ctryPoly@data[,'NAME_1']),
fill = TRUE,
fillColor = pal[cutClusts],
fillOpacity = 0.9,
stroke = TRUE,
weight=1,
smoothFactor = 0.7,
opacity = 1,
color="white",
dashArray = "5",
group = admLevel,
highlight = leaflet::highlightOptions(
weight = 5,
color = "#666",
dashArray = "",
fillOpacity = 0,
bringToFront = TRUE),
label = mapLabels,
labelOptions = leaflet::labelOptions(
style = list("font-weight" = "normal",
padding = "3px 8px"),
textsize = "15px",
direction = "auto"
)
)
map <- map %>% leaflet::addLayersControl(overlayGroups = admLevel)
map <- map %>% leaflet::addLegend(position = "bottomright",
colors = pal[unique(cutClusts)],
labels = unique(cutClusts),
#title = "Nightlight percentiles",
title = "clusters",
opacity = 1 )
map
})
})
######################## renderPlot plotTSDecomposed ###################################
output$plotTSDecomposed <- shiny::renderPlot({
#print(paste0("here: plotTSDecomposed"))
input$btnGo
countries <- shiny::isolate(getInputCountries())
if(length(countries) < 1)
return()
normArea <- input$norm_area
admLevel <- unlist(ctryAdmLevels())[2]
#return if the country doesn't have adm levels below country
if (is.null(admLevel) || admLevel == "")
return()
scale <- input$scale
shiny::isolate({
nlType <- input$nlType
#meltCtryData <- ctryNlDataMeltedLvl2()
meltCtryData <- ctryNlDataMelted()
if(nrow(meltCtryData) < 2)
return()
if (normArea)
meltCtryData$value <- meltCtryData$value/meltCtryData$area_sq_km
ctryAvg <- meltCtryData
#ctryAvg <- aggregate(value ~ country, data=meltCtryData, mean)
#ctryAvg <- stats::setNames(meltCtryData[,mean(value, na.rm = TRUE), by = list(meltCtryData[[make.names(admLevel)]], variable)], c(admLevel, "variable", "value"))
if(stringr::str_detect(nlType, "\\.D"))
fmt <- "%Y-%M-%d"
else if(stringr::str_detect(nlType, "\\.M"))
fmt <- "%Y-%M-%d"
else if(stringr::str_detect(nlType, "\\.Y"))
fmt <- "%Y"
minDate <- as.character(min(ctryAvg$variable))
maxDate <- as.character(max(ctryAvg$variable))
if(stringr::str_detect(nlType, "\\.Y") && stringr::str_detect(minDate, "\\d+$"))
{
minDate <- paste0(minDate, "-01-01")
maxDate <- paste0(maxDate, "-01-01")
freq <- 2
}
startYear <- lubridate::year(as.Date(minDate, fmt))
endYear <- lubridate::year(as.Date(maxDate, fmt))
if(startYear == endYear)
stop(Sys.time(), ": Only 1 data point (year) in the dataset")
tsStart <- c(startYear)
tsEnd <- c(endYear)
if(stringr::str_detect(nlType, "\\.D|\\.M"))
{
startMonth <- lubridate::month(lubridate::ymd(min(ctryAvg$variable)))
endMonth <- lubridate::month(lubridate::ymd(max(ctryAvg$variable)))
tsStart <- c(tsStart, startMonth)
tsEnd <- c(tsEnd, endMonth)
freq <- 12
}
if(stringr::str_detect(nlType, "\\.D"))
{
startDay <- lubridate::day(lubridate::ymd(max(ctryAvg$variable)))
endDay <- lubridate::month(lubridate::ymd(max(ctryAvg$variable)))
tsStart <- c(tsStart, startDay)
tsEnd <- c(tsEnd, endDay)
freq <- 7
}
ctryDataTS <- stats::ts(ctryAvg$value, start = tsStart, end = tsEnd, frequency = freq)
ctryDataTScomponents <- stats::decompose(ctryDataTS)
#g <- ggplot2::autoplot(ctryDataTScomponents)
graphics::plot(ctryDataTScomponents)
})
})
######################## plotYearly ###################################
output$plotYearly <- shiny::renderPlot({
#print(paste0("here: renderPlotYearly"))
input$btnGo
countries <- shiny::isolate(getInputCountries())
if (is.null(countries))
return()
scale <- input$scale
nlPeriodRange <- input$nlPeriodRange
graphType <- input$graphType
normArea <- input$norm_area
shiny::isolate({
nlType <- input$nlType
ctryData <- ctryNlDataMeltedLvl2()
if (is.null(countries) || is.null(ctryData))
return()
admLevel <- unlist(ctryAdmLevels())[1]
#print(paste0("admLevel:", admLevel))
if (!exists("admLevel") || is.null(admLevel) || length(admLevel)==0)
admLevel <- "country"
ctryData$year <- lubridate::year(as.Date(as.character(ctryData$variable), "%Y"))
lstAggBy <- paste0("list(", admLevel, ", variable")
lstAggBy <- paste0(lstAggBy, ", as.factor(year)")
aggNames <- "year"
if(stringr::str_detect(nlType, "\\.M"))
{
ctryData$month <- lubridate::month(as.Date(as.character(ctryData$variable)))
lstAggBy <- paste0(lstAggBy, ", as.factor(month)")
aggNames <- c(aggNames, "month")
}
lstAggBy <- paste0(lstAggBy, ")")
if(stringr::str_detect(nlType, "\\.D"))
{
ctryData$day <- lubridate::day(as.Date(as.character(ctryData$variable)))
lstAggBy <- paste0(lstAggBy, ", as.factor(day)")
aggNames <- c(aggNames, "day")
}
#print(paste0("ctrydata nrow:", nrow(ctryData)))
if (normArea)
ctryData$value <- (ctryData$value)/ctryData$area_sq_km
if (length(countries)==1)
{
#switched to data.table aggregation
#ctryData <- stats::setNames(aggregate(ctryData$value, by=list(ctryData[,admLevel], ctryData[,"variable"]), mean, na.rm=T), c(admLevel, "variable", "value"))
ctryData <- stats::setNames(
ctryData[,list(mean(value, na.rm = TRUE)),
by = eval(parse(text=lstAggBy))],
c(admLevel, "variable", aggNames, "value"))
g <- ggplot2::ggplot(ctryData, aes(x=eval(parse(text=aggNames[length(aggNames)])), y=value, col=year, group=year)) + ggplot2::geom_line(alpha=0.3) + ggplot2::geom_point() + ggplot2::geom_smooth(aes(group=1),method = "loess", weight=1,alpha=0.2, lty='twodash') #+ theme(axis.text.x=element_text(angle=90,hjust=1,vjust=0.5)) #+ labs(col=year)
}
else
{
#ctryData <- aggregate(value ~ country+variable, data=ctryData, mean)
#switched to data.table aggregation
ctryData <- stats::setNames(ctryData[,mean(value, na.rm = TRUE),by = eval(parse(text=lstAggBy))], c(admLevel, "variable", aggNames, "value"))
#g <- ggplot2::ggplot(data=ctryData, aes(x=variable, y=value, col=country, group=year))
g <- ggplot2::ggplot(ctryData, aes(x=eval(parse(text=aggNames[length(aggNames)])), y=value, col=country, shape=year, group=interaction(country,year))) + ggplot2::geom_line(lwd=.5, alpha=0.3) + ggplot2::geom_point()+ ggplot2::geom_smooth(aes(group=country),method = "loess", weight=1,alpha=0.2, lty='twodash')
}
if ("scale_y_log" %in% scale)
g <- g + ggplot2::scale_y_log10()
if ("scale_x_log" %in% scale)
g <- g + ggplot2::scale_x_log10()
if (normArea)
g <- g + ggplot2::labs(title="Nightlight Radiances", x = "Month", y = "Avg Rad (W.Sr^-1.cm^-2/Km2)") #y=expression(paste("Avg Rad W" %.% "Sr" ^{-1} %.% "cm" ^{-2}, "per Km" ^{2})))
else
g <- g + ggplot2::labs(title="Nightlight Radiances", x = "Month", y = "Total Rad (W.Sr^-1.cm^-2)") #y=expression(~Total~Rad~W %.% Sr^{-1}%.%cm^{-2}))
#plotly::ggplotly(g)
g
})
})
######################## plotNightLights ###################################
output$plotNightLights <- plotly::renderPlotly({
#print(paste0("here: renderPlot"))
input$btnGo
countries <- shiny::isolate(getInputCountries())
if (is.null(countries) || length(countries) == 0 || countries == "")
return()
scale <- input$scale
nlPeriodRange <- input$nlPeriodRange
graphType <- input$graphType
nlType <- shiny::isolate(input$nlType)
normArea <- input$norm_area
ctryData <- ctryNlDataMelted()
if (is.null(countries) || is.null(ctryData))
return()
admLvlCtrlNames <- names(input)
x <- admLvlCtrlNames[grep("selectAdm", admLvlCtrlNames)]
shiny::isolate({
admLvlNums <- NULL
for (i in x)
if(length(input[[i]])>0)
admLvlNums <- c(admLvlNums, i)
#print(paste0("x", x))
#print(paste0("admlvlnums:", admLvlNums))
#if (admLvlNum=="" && length(countries)>0)
# return()
admLvlNums <- as.numeric(gsub("[^[:digit:]]","",admLvlNums))
if (length(admLvlNums)==0)
admLvlNums <- 1
ctryAdmLevels <- unlist(ctryAdmLevels())
admLevel <- ctryAdmLevels[as.numeric(data.table::last(admLvlNums))]
#print(paste0("admLevel:", admLevel))
if (!exists("admLevel") || is.null(admLevel) || length(admLevel)==0)
admLevel <- "country"
if(is.null(nlPeriodRange[1]) || is.null(nlPeriodRange[2]))
return()
ctryData <- subset(ctryData, variable >= nlPeriodRange[1] & variable <= nlPeriodRange[2])
for (lvl in admLvlNums)
{
if (lvl == 1)
next()
#print(paste0("lvl:",lvl))
if (length(input[[x[lvl-1]]])>0)
{
ctryData <- subset(ctryData, ctryData[[ctryAdmLevels[lvl]]] %in% input[[x[lvl-1]]])
}
}
#print(paste0("ctrydata nrow:", nrow(ctryData)))
if (normArea)
ctryData$value <- (ctryData$value)/ctryData$area_sq_km
if (graphType == "boxplot")
{
if (length(countries)==1)
{
g <- ggplot2::ggplot(data=ctryData, ggplot2::aes(x=ctryData[[make.names(admLevel)]], y=value, col=ctryData[[make.names(admLevel)]])) + ggplot2::theme(axis.text.x=element_text(angle=90,hjust=1,vjust=0.5)) + ggplot2::labs(col=admLevel) + facet_grid(lubridate::year(variable) ~ lubridate::month(x=variable, label=T, abbr=T))
}
else
{
g <- ggplot2::ggplot(data=ctryData, ggplot2::aes(x=country, y=value, col=country)) + ggplot2::theme(axis.text.x=element_text(angle=90,hjust=1,vjust=0.5),panel.spacing.x=unit(0.1, "lines")) + ggplot2::labs(col=admLevel) + facet_grid(lubridate::year(variable) ~ lubridate::month(x=variable, label=T, abbr=T))
}
#ggplot2::ggplot(data = ctryData, ggplot2::aes(x = factor(variable), y = value, col = country)) + ggplot2::theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)) + ggplot2::labs(col = admLevel) + geom_boxplot() + facet_grid(country ~ .)
g <- g + ggplot2::geom_boxplot()# +facet_grid(.~variable)
}
else if (graphType == "line")
{
if (length(countries)==1)
{
#switched to data.table aggregation
#ctryData <- stats::setNames(aggregate(ctryData$value, by=list(ctryData[,admLevel], ctryData[,"variable"]), mean, na.rm=T), c(admLevel, "variable", "value"))
ctryData <- stats::setNames(ctryData[,mean(value, na.rm = TRUE),by = list(ctryData[[make.names(admLevel)]], variable)], c(admLevel, "variable", "value"))
g <- ggplot2::ggplot(data=ctryData, aes(x=variable, y=value, col=ctryData[[make.names(admLevel)]]))
if(stringr::str_detect(nlType, "VIIRS"))
g <- g + ggplot2::scale_x_date(date_breaks = "1 month", date_labels = "%Y-%m")
}
else
{
#ctryData <- aggregate(value ~ country+variable, data=ctryData, mean)
#switched to data.table aggregation
ctryData <- stats::setNames(ctryData[,mean(value, na.rm = TRUE),by = list(country, variable)], c("country", "variable", "value"))
g <- ggplot2::ggplot(data=ctryData, aes(x=variable, y=value, col=country))
if(stringr::str_detect(nlType, "VIIRS"))
g <- g + ggplot2::scale_x_date(date_breaks = "1 month", date_labels = "%Y-%m")
}
g <- g+ ggplot2::geom_line() + ggplot2::geom_point()+ ggplot2::theme(axis.text.x=element_text(angle=90,hjust=1,vjust=0.5)) + ggplot2::labs(col=admLevel)
}
else if (graphType == "histogram")
{
#ctryData <- aggregate(value ~ country+variable, data=ctryData, mean)
g <- ggplot2::ggplot(data=ctryData, aes(x=value))
g <- g + ggplot2::geom_histogram(aes(y=..density..), bins = 30, colour="black", fill="white") + ggplot2::geom_density(alpha=.2, fill="#FF6666") + ggplot2::facet_grid(ctryData[[make.names(admLevel)]] ~ lubridate::year(variable)) # Overlay with transparent density plot
}
else
return(NULL)
if ("scale_y_log" %in% scale)
g <- g + ggplot2::scale_y_log10()
if ("scale_x_log" %in% scale)
g <- g + ggplot2::scale_x_log10()
if (normArea)
g <- g + ggplot2::labs(title="Nightlight Radiances", x = "Month", y = "Avg Rad (W.Sr^-1.cm^-2/Km2)") #y=expression(paste("Avg Rad W" %.% "Sr" ^{-1} %.% "cm" ^{-2}, "per Km" ^{2})))
else
g <- g + ggplot2::labs(title="Nightlight Radiances", x = "Month", y = "Total Rad (W.Sr^-1.cm^-2)") #y=expression(~Total~Rad~W %.% Sr^{-1}%.%cm^{-2}))
p <- plotly::ggplotly(g)
p$elementId <- NULL
p
})
})
######################## renderDataTable dataset ###################################
output$dataset <- DT::renderDataTable({
if(is.null(ctryNlData()))
return()
ctryData <- ctryNlData()
allCols <- names(ctryData)
dataCols <- grep("NL_", allCols, value = T)
admCols <- setdiff(allCols, dataCols)
if(!is.null(input$nlType))
dataCols <- grep(input$nlType, dataCols, value = T)
if(!is.null(input$nlPeriod))
dataCols <- grep(input$nlPeriod, dataCols, value = T)
if(!is.null(input$ctryStat))
dataCols <- grep(input$ctryStat, dataCols, value = T)
ctryData <- ctryData[, c(admCols, dataCols), with=F]
},
options = list(scrollX = TRUE, scrolly = TRUE)
)
######################## observe map ###################################
# observe({
# if(!exists("nlPeriod"))
# return()
#
# nlYm <- substr(gsub("-", "", nlPeriod[1]), 1, 6)
# ctryPeriod <- paste0(countries, "_", nlYm)
#
# leafletProxy("map") %>%
# clearTiles("nlRaster") %>%
# addWMSTiles(baseUrl = "http://localhost/cgi-bin/mapserv?map=test.map", layers = ctryPeriod, options = WMSTileOptions(format = "image/png", transparent = TRUE, opacity=0.5), layerId="nlRaster")
# })
# observeEvent(input$admLevel, {
# print(paste0("here: observe admLevel 2 update map"))
# admLevel <- input$admLevel
# countries <- input$countries
#
# if (input$drawMap == 0)
# return()
#
# lyrs <- unlist(ctryAdmLevels())
#
# lyrNum <- which(lyrs == admLevel) - 1
#
# ctryPoly <- Rnightlights::readCtryPolyAdmLayer(countries, ifelse(is.null(admLevel), yes = Rnightlights::getCtryShpLyrNames(countries,0), no = Rnightlights::getCtryShpLyrName(countries,lyrNum)))
# s
# proxy <- leafletProxy("map", data=ctryPoly)
#
# print("drawing leaflet proxy")
# proxy %>%
# clearShapes() %>%
# addPolygons(fill = FALSE, stroke = TRUE, weight=3, smoothFactor = 0.7, opacity = 0.5, color="green")
# })
######################## map ###################################
output$map <- leaflet::renderLeaflet({
#print(paste0("here: draw leaflet map"))
# Use leaflet() here, and only include aspects of the map that
# won't need to change dynamically (at least, not unless the
# entire map is being torn down and recreated).
input$btnGo
if(is.null(getInputCountries()) || is.null(input$nlPeriod) || is.null(input$nlType))
return()
countries <- shiny::isolate(getInputCountries())
nlPeriod <- input$nlPeriod
admLevel <- shiny::isolate(input$admLevel)
scale <- input$scale
nlType <- shiny::isolate(input$nlType)
normArea <- input$norm_area
polySrc <- input$polySrc
polyVer <- input$polyVer
polyType <- input$polyType
if(is.null(polySrc) || is.null(polyVer) || polySrc == "" || polyVer == "")
return()
shiny::isolate({
# if (is.null(countries) || is.null(nlPeriod) || is.null(admLevel))
# return()
if (length(countries) == 0)
{
shiny::renderText("Please select only one country/region")
return()
}
if(length(countries) > 1)
{
admLevel <- "country"
}
map <- leaflet::leaflet() %>%
leaflet::addTiles("http://a.basemaps.cartocdn.com/dark_all/{z}/{x}/{y}.png")
for(country in countries)
{
admLvlCtrlNames <- names(input)
x <- admLvlCtrlNames[grep("selectAdm", admLvlCtrlNames)]
admLvlNums <- NULL
for (i in x)
if(length(input[[i]])>0)
admLvlNums <- c(admLvlNums, i)
#print(paste0("x", x))
#print(paste0("admlvlnums:", admLvlNums))
admLvlNums <- as.numeric(gsub("[^[:digit:]]","",admLvlNums))
#print(paste0("admlvlNums:", admLvlNums))
#get the selected admLevel and convert to lyrnum
ctryAdmLevels <- Rnightlights:::getCtryStructAdmLevelNames(ctryCode = country,
gadmVersion = polyVer,
gadmPolyType = polyType,
custPolyPath = NULL)
#ctryAdmLevels <- unlist(ctryAdmLevels[which(countries == country)])
if(!is.null(admLevel) || admLevel == "country")
lyrNum <- which(ctryAdmLevels == admLevel)
else
lyrNum <- 0
#line weight increases. max=4 min=1
deltaLineWt <- (4 - 1) / as.numeric(lyrNum)
if(stringr::str_detect(nlType, "OLS"))
nlYm <- nlPeriod
else if (stringr::str_detect(nlType, "VIIRS"))
nlYm <- as.Date(nlPeriod, "%Y%m%d")
ctryData <- ctryNlDataMelted()
if (is.null(ctryData))
return()
#get our data ready to match with polygons
#subset data based on level selections
if(stringr::str_detect(nlType, "OLS"))
ctryData <- subset(ctryData, variable == nlYm)
else if(stringr::str_detect(nlType, "VIIRS"))
ctryData <- subset(ctryData, lubridate::year(variable) == lubridate::year(nlYm) & lubridate::month(variable) == lubridate::month(nlYm))
if (normArea)
ctryData$value <- (ctryData$value)/ctryData$area_sq_km
#print(paste0("ctrydata nrow:", nrow(ctryData)))
#print("drawing leaflet")
ctryPeriod <- paste0(country, "_", nlYm)
#message(ctryPeriod)
ctryPoly0 <- Rnightlights::readCtryPolyAdmLayer(ctryCode = country, admLevel = unlist(Rnightlights::getCtryShpLyrNames(country,0)))
if(stringr::str_detect(nlType, "OLS"))
nlPeriod <- substr(gsub("-","",nlYm),1,4)
else if(stringr::str_detect(nlType, "VIIRS"))
nlPeriod <- substr(gsub("-","",nlYm),1,6)
ctryRastFilename <- Rnightlights::getCtryRasterOutputFnamePath(ctryCode = country,nlType = nlType, nlPeriod = nlPeriod)
if(file.exists(ctryRastFilename))
{
ctryRast <- raster::raster(ctryRastFilename)
#raster::projection(ctryRast) <- wgs84
}
else
ctryRast <- NULL
if(country == countries[1])
map <- map %>% leaflet::addTiles()
if(inherits(ctryRast, "RasterLayer"))
{
map <- map %>% leaflet::addRasterImage(x = ctryRast,layerId = c("ctryRasterLocal_", country), group = "ctryRaster", project = T)
leaflet::projectRasterForLeaflet(x = ctryRast, method = "bilinear")
}
#map <- map %>% leaflet::addWMSTiles(layerId="nlRaster",
# baseUrl = "http://localhost/cgi-bin/mapserv?map=nightlights_wms.map",
# layers = "ctryRasterWMS",
# group = "ctryRaster",
# options = leaflet::WMSTileOptions(format = "image/png",
# transparent = TRUE, opacity=1)
# ) %>%
map <- map %>% leaflet::addPolygons(layerId = country,
fill = FALSE,
fillColor = "#fefe40",
stroke = TRUE,
weight=4,
smoothFactor = 0.7,
opacity = 1,
color="white",
dashArray = "5",
group = "country",
data=ctryPoly0
)
selected <- NULL
if(lyrNum > 1) #skip drawing the country level. avoid reverse seq (2:1)
for(iterAdmLevel in 2:lyrNum)
{
#aggregate the data to the current level
iterAdmLevelName <- ctryAdmLevels[iterAdmLevel]
#data already in data.table form
lvlCtryData <- stats::setNames(ctryData[,list(mean(value,na.rm=T), sum(area_sq_km, na.rm=T)), by=list(ctryData[[iterAdmLevelName]], ctryData[["variable"]])], c(iterAdmLevelName, "variable", "value", "area_sq_km"))
#rank the data
varname <- paste0('rank',iterAdmLevel)
lvlCtryData[[varname]] <- with(lvlCtryData, rank(-value, ties.method = 'first'))
#palette deciles for the layer
bins <- unique(stats::quantile(lvlCtryData$value, seq(0,1,0.1), na.rm=T))
brewerPal <- rev(RColorBrewer::brewer.pal(10, "YlOrRd"))
pal <- leaflet::colorBin(brewerPal, domain = lvlCtryData$value, na.color = "grey", bins=bins)
#turn off previous layer? No point keeping it if it is hidden. Also we want to turn the current layer to transparent so that one can see through to the raster layer on hover
ctryPoly <- Rnightlights::readCtryPolyAdmLayer(country, unlist(Rnightlights::getCtryShpLyrNames(country, iterAdmLevel-1)))
ctryPoly <- sp::spTransform(ctryPoly, wgs84)
if (length(admLvlNums) > 0)
if((iterAdmLevel) == data.table::last(admLvlNums)) #iterAdmLevel+1 %in% admLvlNums)
selected <- which(ctryPoly@data[[paste0("NAME_",iterAdmLevel-1)]] %in% input[[paste0("selectAdm", iterAdmLevel)]])
else
selected <- c()
mapLabels <- sprintf(
paste0("<strong>%s:%s</strong>", "<br/>Area: %s km<superscript>2</superscript>","<br/>Date: %s", ifelse(normArea, "<br/>Rad: %s /sq.km", "<br/>Rad: %s"), "<br/>Rank: %s/%s"),
ctryAdmLevels[iterAdmLevel], lvlCtryData[[ctryAdmLevels[iterAdmLevel]]], format(lvlCtryData[["area_sq_km"]],scientific = T,digits = 2), lvlCtryData[["variable"]], format(lvlCtryData[["value"]],scientific = T,digits = 2), lvlCtryData[[paste0("rank",iterAdmLevel)]], nrow(lvlCtryData)
) %>% lapply(htmltools::HTML)
map <- map %>% leaflet::addPolygons(
data = ctryPoly,
layerId = as.character(ctryPoly@data[,paste0('NAME_',iterAdmLevel-1)]),
fill = TRUE,
fillColor = ~pal(lvlCtryData[["value"]]),
fillOpacity = 0.9,
stroke = TRUE, weight=4-(iterAdmLevel-1)*deltaLineWt,
smoothFactor = 0.7,
opacity = 1,
color="white",
dashArray = "5",
group = ctryAdmLevels[iterAdmLevel],
highlight = leaflet::highlightOptions(
weight = 5,
color = "#666",
dashArray = "",
fillOpacity = 0,
bringToFront = TRUE),
label = mapLabels,
labelOptions = leaflet::labelOptions(
style = list("font-weight" = "normal",
padding = "3px 8px"),
textsize = "15px",
direction = "auto"
)
)
for (iterPoly in selected)
{
map <- map %>% leaflet::addPolygons(
data = ctryPoly[iterPoly,],
layerId = paste0(as.character(ctryPoly@data[iterPoly, paste0('NAME_',iterAdmLevel-1)]),"_selected"),
fill = TRUE,
fillColor = ~pal(lvlCtryData[["value"]][iterPoly]),
fillOpacity = 0.9,
stroke = TRUE,
weight=4-(iterAdmLevel-1)*deltaLineWt+0.5,
smoothFactor = 0.7,
opacity = 1,
color="blue",
# dashArray = "5",
group = "selected",
highlight = leaflet::highlightOptions(
weight = 5,
color = "blue",
dashArray = "",
fillOpacity = 0,
bringToFront = TRUE),
label = mapLabels[iterPoly],
labelOptions = leaflet::labelOptions(
style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "15px",
direction = "auto"
)
)
e <- raster::extent(ctryPoly[iterPoly,])
if (exists("mapExtent"))
{
mapExtent@xmin <- min(mapExtent@xmin, e@xmin)
mapExtent@ymin <- min(mapExtent@ymin, e@ymin)
mapExtent@xmax <- max(mapExtent@xmax, e@xmax)
mapExtent@ymax <- max(mapExtent@ymax, e@ymax)
}
else
{
mapExtent <- e
}
}
}
}
map <- map %>% leaflet::addLayersControl(overlayGroups = c("ctryRaster", ctryAdmLevels[2:lyrNum], "selected"))
if (admLevel != "country")
map <- map %>% leaflet::addLegend(position = "bottomright",
pal = pal,
values = format(ctryData$value, scientific = T),
labels = stats::quantile(ctryData$value, seq(0,1,0.1), na.rm=T),
#title = "Nightlight percentiles",
title = ifelse(normArea, "Rad/sq. Km.", "Total Rad"),
opacity = 1 )
# #Zoom in disabled
# if (exists("mapExtent"))
# map <- map %>% fitBounds(mapExtent@xmin, mapExtent@ymin, mapExtent@xmax, mapExtent@ymax)
map
})
})
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.