Commit d2c177de authored by Facundo Muñoz's avatar Facundo Muñoz ®️
Browse files

Merge branch 'interface_v2'

# Conflicts:
#	inst/interface/server.R

- fixes #8
parents 403ad960 3269892b
Package: mapMCDA
Title: Produce an epidemiological risk map by weighting multiple risk factors
Version: 0.3.8
Version: 0.4
Date: 2019-04-06
Authors@R: c(
person("Andrea", "Apolloni", email = "andrea.apolloni@cirad.fr", role = c("ctb"), comment = "Animal mobility algorithm"),
......@@ -38,6 +38,7 @@ Imports:
rhandsontable,
shiny,
shinydashboard,
shinyFiles,
sp,
stringr,
utils
......
# mapMCDA 0.4
* shiny interface v2 with several improvements (#8)
* several bugfixes
# mapMCDA 0.3.0
* Plot geographic networks (#13)
......
......@@ -38,8 +38,7 @@ risk_layer <- function(x, boundaries, scale_target = c(0, 100)) {
scale_source <- range(raster::values(r), na.rm = TRUE)
if (isTRUE(all.equal(diff(scale_source), 0))) {
stop("Risk factor ", substitute(x),
" has a constant value and cannot be used as it is.\n",
stop("This risk factor has a constant value and cannot be rescaled.\n",
"Please correct or remove.")
}
......
################### PURPOSE OF THE APP ###################
#Interface for PRODEL project
#May 2018, by Sylvain Falala, Unit CIRAD-INRA ASTRE
# Interface for mapMCDA project
# April 2019, by Sylvain Falala, Unit CIRAD-INRA ASTRE
################### LIBRARIES ###################
library(stringr) # to work with character strings
library(rgdal) #to work with spatial vector
library(raster) #to work with spatial raster
library(shiny)
library(rgdal) # to work with spatial vector
library(raster) # to work with spatial raster
library(igraph) # to work with igraph geonetwork
library(shiny) # to develop web interface
library(shinydashboard) # to create dashboard
library(rhandsontable) # editable table
library(rhandsontable) # to use an editable table
library(shinyFiles) # to load layer files locally
wImage <- 1024
hImage <- 768
#### MAIN VARIABLES ####
appTitle <- "MapMCDA"
vectorExt <- c("shp", "gpkg")
rasterExt <- c("tif", "tiff")
#### LANGUAGE ####
mobExt <- "csv"
# Language to use: 1 = english, 2 = french
indLang <- 1
acceptLayerType <- paste0(".", c(vectorExt, rasterExt))
# Radio buttons to select language
langChoiceNames <- list(HTML("English"), HTML("Français"))
langChoiceVal <- list("1","2")
reExt <- "\\.\\w{1,}$" # regular expression to define file extension
# 1 layer in global environment is a list with :
# 1: raw layer
# 2: scale target
# 3: standardized layer
indRawLay <- 1
indScale <- 2
indStandLay <- 3
nbLayIndex <- 3
langDF <- data.frame(
# SIDEBAR
"MenuFile" = c("Files", "Fichiers"),
"MenuUnit" = c("Epidemiological units", "Unités épidémiologiques"),
"MenuRisk" = c("Risk factors", "Facteurs de risque"),
"MenuWeight" = c("Weights", "Poids"),
"MenuResult" = c("Results", "Résultats"),
# Files box
"BoxFile" = c("Files", "Fichiers"),
"TitleFileInput" = c("Select layers", "Sélectionnez les fichiers de vecteurs et rasters"),
"ButtonFileInput" = c("Browse...", "Parcourir..."),
"BoxLayer" = c("Layers", "Couches"),
# Epidemiological units box
"BoxUnitMap" = c("Map", "Carte"),
"BoxUnitStat" = c("Statistics", "Statistiques"),
# Risk factors box
"BoxRiskRawMap" = c("Original scale", "Échelle originale"),
"BoxRiskStandRaster" = c("Risk scale", "Échelle de risque"),
"ABRiskRasterInvert" = c("Invert", "Inverser"),
"RBRiskLayer" = c("Scale risk factors",
"Mise en échelle des facteurs de risque"),
# Weights box
"BoxWeightMatrix" = c("Pairwise comparison Matrix", "Matrice de comparaison par paires"),
"BoxWeightBar" = c("Weights Histogram", "Histogramme des poids"),
# Results box
"BoxResult" = c("Combined risk", "Risque combiné"),
"BoxResultPerUnit" = c("Per Epidemiological unit","Par unité épidémiologique"),
"SIRiskLevel" = c("# Risk categories", "# Catégories de risque"),
"DownButton" = c("Export", "Exporter"),
stringsAsFactors = FALSE)
preloadPath <- "preload"
langDF <- t(langDF)
vectNames <- c("name", "size", "type", "datapath", "layerType", "shortName", "originalName", "adminUnit")
glUploadFileDF <- NULL
glLayerDF <- NULL
glWeightMatrix <- NULL
# Type of layer
lVect <- c("Vector", "Vecteur")
lRast <- c("Raster", "Raster")
lMob <- c("MobGraph","MobGraph")
langFileList <- c("Accepted files", "Fichiers acceptés")
# langLayerRemove <- c("Remove", "Supprimer")
# Columns to retrieve in data frame of layers for editable table
toEditLayerColNames <- c("originalName", "shortName", "layerType", "adminUnit")
......@@ -51,6 +90,7 @@ toEditLayerColNames <- c("originalName", "shortName", "layerType", "adminUnit")
langLayerList <- list(c("Name_orig", "Name_new", "Type", "Admin_unit"),
c("Nom_orig", "Nom_modif", "Type", "Unite_admin"))
# Columns read only in editable table of layers
lockOrigNameCol <- 1
lockTypeCol <- 3
......@@ -60,30 +100,15 @@ newNameCol <- 2
newAdminCol <- 4
#### LANGUAGE ####
# Language to use: 1 = english, 2 = french
indLang <- 1
#languages <- c("English" = "1", "Francais" = "2")
# Fichiers
langMenuFile <- c("Files","Fichiers")
langBoxFile <- langMenuFile
langFileList <- c("Names","Noms")
langBoxLayer <- c("Layers", "Couches")
# Help text on interface
langHelpFiles <- c(
"Import files, including a vector map with epidemiological units.",
"Importer fichiers, y-compris une carte vectorielle avec des unités épidémiologiques."
"Importer les fichiers, y-compris une carte vectorielle avec des unités épidémiologiques."
)
langHelpLayers <- c(
"Check the epidemiological units layer.",
"Signaler la couche d'unités épidémiologiques."
"Indiquer la couche d'unités épidémiologiques."
)
langHelpScale <- c(
......@@ -97,194 +122,4 @@ langHelpMatrix <- c(
)
# Epidemiological unit
langMenuUnit <- c("Epidemiological units","Unit&#233;s &#233;pid&#233;miologiques")
langBoxUnitMap <- c("Map", "Carte")
langBoxUnitStat <- c("Statistics", "Statistiques")
# Risk factors
langMenuRisk <- c("Risk factors","Facteurs de risque")
langBoxRiskRawMap <- c("Original scale", "Échelle originale")
langBoxRiskStandRaster <- c("Risk scale", "Échelle de risque")
langRBRiskLayer <- c("Scale risk factors",
"Mise en échelle des facteurs de risque")
langABRiskRasterInvert <- c("Invert", "Inverser")
# Weight
langMenuWeight <- c("Weight","Poids")
langBoxWeightMatrix <- c("Pairwise comparison Matrix", "Matrice de comparaison par paires")
langBoxWeightBar <- c("Weights histogram", "Histogramme des poids")
# Results
langMenuResult <- c("Results","R&#233;sultats")
langAdminUnitResult <- c("Per Epidemiological unit","Par unité épidémiologique ")
langLevelResult <- c("Risk level:", "Niveau de risque :")
# Type of layer
lVect <- c("Vector","Vecteur")
lRast <- c("Raster","Raster")
lMob <- c("MobGraph","MobGraph")
langTitleFileInput <- c("Select layers",
"S&#233;lectionnez les fichiers de vecteurs - rasters - mobilite")
langButtonFileInput <- list(c("Browse...", "No file selected"),
c("Parcourir...", "Pas de selection"))
langLayerRemove <- c("Remove", "Supprimer")
################### MAIN PROGRAM ###################
#List preload files
outbFiles <- list.files(path = preloadPath)
if(!is.na(outbFiles[1])){
nbFiles <- length(outbFiles)
glLayerDF <- data.frame(matrix(nrow = nbFiles, ncol = length(vectNames)), stringsAsFactors = FALSE)
colnames(glLayerDF) <- vectNames
glLayerDF$name <- outbFiles
glLayerDF$datapath <- paste(preloadPath, outbFiles, sep = "/")
glUploadFileDF <- subset(glLayerDF, select = c("name", "size", "type", "datapath"))
# Retrieve file extension to define type of layer: vector or raster
fileExt <- str_extract(glLayerDF$name, reExt)
fileExt <- tolower(str_replace(fileExt, "\\.", ""))
glLayerDF$layerType <- rep("Unknown", nbFiles)
indVect <- which(fileExt %in% vectorExt)
if(!is.na(indVect[1])) glLayerDF[indVect,"layerType"] <- lVect[indLang]
indRast <- which(fileExt %in% rasterExt)
if(!is.na(indRast[1])) glLayerDF[indRast,"layerType"] <- lRast[indLang]
indMob <- which(fileExt %in% mobExt)
if(!is.na(indMob[1])) layerFiles[indMob,"layerType"] <- lMob[indLang]
#Remove unknown file type
indRem <- which(glLayerDF$layerType=="Unknown")
if(!is.na(indRem[1])) glLayerDF <- glLayerDF[-indRem,]
# Create short name for the layer based on the file name
# Remove file extension
glLayerDF$shortName <- gsub(reExt, "", glLayerDF$name, ignore.case = TRUE, perl = TRUE)
# Remove special characters
glLayerDF$shortName <- iconv(glLayerDF$shortName, from = "UTF-8", to = "ASCII", sub = "")
# Remove blanks
glLayerDF$shortName <- gsub("\\s+", "", glLayerDF$shortName, ignore.case = TRUE, perl = TRUE)
glLayerDF$originalName <- glLayerDF$shortName
nbLayer <- nrow(glLayerDF)
layerNames <- sort(glLayerDF$shortName)
# If layer is administrative units
glLayerDF$adminUnit <- rep(FALSE, nbLayer)
# Load in global environment
for(k in 1:nbLayer){
#If vector
if(glLayerDF[k,"layerType"]==lVect[indLang]){
# If shape file
if(str_detect(glLayerDF[k,"name"], ".shp")){
# Retrieve path of shp file to define dsn
shpDir <- gsub(paste("/", glLayerDF[k,"name"], sep = ""),"", glLayerDF[k,"datapath"])
# Extract shp file name without extension to define layer name
shpLayer <- gsub(".shp","", glLayerDF[k,"name"])
}
# If geopackage file
if(str_detect(glLayerDF[k,"name"], ".gpkg")){
# Retrieve path of shp file to define dsn
shpDir <- glLayerDF[k,"datapath"]
# Extract shp file name without extension to define layer name
shpLayer <- gsub(".gpkg","", glLayerDF[k,"name"])
}
curLay <- readOGR(dsn = shpDir, layer = shpLayer, verbose = FALSE)
}
#If raster
if(glLayerDF[k,"layerType"]==lRast[indLang]){
curLay <- raster(glLayerDF[k,"datapath"])
}
# If csv mobility file
if(layerFiles[k,"layerType"]==lMob[indLang]){
curLay <- read_network(layerFiles[k,"datapath"])
}
curLayerName <- paste("layer_", glLayerDF[k,"shortName"], sep = "")
# Pre-allocate list for layer
curLayerList <- vector("list", nbLayIndex)
curLayerList[[indRawLay]] <- curLay
curLayerList[[indScale]] <- NA
curLayerList[[indStandLay]] <- NA
#Save in global environment the current layer
assign(x = curLayerName,
value = curLayerList,
envir = .GlobalEnv)
}
#Initialize weight matrix
glWeightMatrix <- matrix(data = 1.0, nrow = nbLayer, ncol = nbLayer, dimnames = list(layerNames, layerNames))
rm(nbFiles, indVect, indRast, indRem, fileExt, nbLayer, layerNames)
}
This diff is collapsed.
################### PURPOSE OF THE APP ###################
#Interface for PRODEL project
#May 2018, by Sylvain Falala, Unit CIRAD-INRA ASTRE
# Interface for mapMCDA project
# April 2019, by Sylvain Falala, Unit CIRAD-INRA ASTRE
################### UI ###################
#### SIDEBAR ####
sidebar <- dashboardSidebar(
# Radio buttons to select language
radioButtons(inputId = "rbLanguage",
label = NULL,
choiceNames = langChoiceNames,
choiceValues = langChoiceVal,
selected = as.character(indLang),
inline = FALSE),
sidebarMenu(id = "tabs",
# Menu for input files
menuItem(HTML(langMenuFile[indLang]), tabName = "fileTab"),
# Menu for epidemiological unit
menuItem(HTML(langMenuUnit[indLang]), tabName = "unitTab"),
# Menu for risk factors
menuItem(HTML(langMenuRisk[indLang]), tabName = "riskTab"),
# Menu for weight table
menuItem(HTML(langMenuWeight[indLang]), tabName = "weightTab"),
# Menu for results
menuItem(HTML(langMenuResult[indLang]), tabName = "resultTab")
# Menu for input files
menuItem(uiOutput("fileMenuTextUI"), tabName = "fileTab"),
# Menu for epidemiological units
menuItem(uiOutput("unitMenuTextUI"), tabName = "unitTab"),
# Menu for risk factors
menuItem(uiOutput("riskMenuTextUI"), tabName = "riskTab"),
# Menu for weight table
menuItem(uiOutput("weightMenuTextUI"), tabName = "weightTab"),
# Menu for results
menuItem(uiOutput("resultMenuTextUI"), tabName = "resultTab")
)
)
#### BODY ####
body <- dashboardBody(
tabItems(
# Files
tabItem("fileTab",
fluidRow(
## File load
box(
title = HTML(langBoxFile[indLang]),
status = "primary",
width = 5,
solidHeader = TRUE,
footer = langHelpFiles[indLang],
# To upload shape and raster files
fileInput(
inputId = "fiLayer",
label = HTML(langTitleFileInput[indLang]),
multiple = TRUE,
accept = NULL,
#acceptLayerType,
width = NULL,
buttonLabel = HTML(langButtonFileInput[[indLang]][1]),
placeholder = HTML(langButtonFileInput[[indLang]][2])
),
# List of all upload files
tableOutput("allFileTable")
box(title = uiOutput("fileBoxTextUI"), status = "primary", width = 5, solidHeader = TRUE,
footer = uiOutput("fileBoxHelpTextUI"),
# Button from shinyFiles package
# To upload vector, raster and igraph files
shinyFilesButton(id = "file",
label = uiOutput("fileInputButtonLblTextUI"),
title = "Please select a file",
multiple = TRUE),
# # Shiny basic fileInput
# # To upload vector, raster and igraph files
# fileInput(inputId = "fiLayer",
# label = uiOutput("fileInputTextUI"),
# multiple = TRUE,
# accept = NULL, #acceptLayerType,
# width = NULL,
# buttonLabel = uiOutput("fileInputButtonLblTextUI"),
# placeholder = "No file"),
# List of accepted files
tableOutput("accFileTable")
),
## Layer table
box(
title = HTML(langBoxLayer[indLang]),
status = "success",
width = 7,
solidHeader = TRUE,
footer = langHelpLayers[indLang],
# List of layers. Name is editable
rHandsontableOutput("rhLayerTable")
box(title = uiOutput("layerBoxTextUI"), status = "success", width = 7, solidHeader = TRUE,
footer = uiOutput("layerBoxHelpTextUI"),
# List of layers. Name is editable
rHandsontableOutput("rhLayerTable")
)
)
),
tabItem(
"unitTab",
uiOutput("unitNameText"),
box(
title = HTML(langBoxUnitMap[indLang]),
status = "primary",
width = 6,
solidHeader = TRUE,
plotOutput("unitMapDisplay")
),
box(
title = HTML(langBoxUnitStat[indLang]),
status = "success",
width = 6,
solidHeader = TRUE,
textOutput("unitStatText"),
plotOutput("unitStatDisplay")
)
),
tabItem(
"riskTab",
uiOutput("uiRiskLayerList"),
box(
title = HTML(langBoxRiskRawMap[indLang]),
status = "primary",
width = 6,
solidHeader = TRUE,
plotOutput("rawLayerDisplay")
),
box(
title = HTML(langBoxRiskStandRaster[indLang]),
status = "success",
width = 6,
solidHeader = TRUE,
plotOutput("standRasterDisplay")
),
box(
status = "info",
width = 6,
solidHeader = FALSE,
langHelpScale[indLang]
),
actionButton(
inputId = "abInvert",
label = langABRiskRasterInvert[indLang]
)
),
tabItem("weightTab",
# Epidemiological units
tabItem("unitTab",
fluidRow(
box(
title = HTML(langBoxWeightMatrix[indLang]),
status = "primary",
width = 9,
solidHeader = TRUE,