Skip to content
GitLab
Commit a9b1ff61 authored by Sylvain Falala's avatar Sylvain Falala
Browse files

new structure of code of interface 

Use shinyFiles
parent 169ffc4d
Expand all Hide whitespace changes
Inline Side-by-side
inst/interface/global.R
View file @ a9b1ff61
################### 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("Raw", "Brut"),
"BoxRiskStandRaster" = c("Standardized raster", "Raster standardisé"),
"ABRiskRasterInvert" = c("Invert", "Inverser"),
"RBRiskLayer" = c("Select layer to compute standardized raster:",
"Sélectionnez la couche pour calculer le raster :"),
# Weights box
"BoxWeightMatrix" = c("Weight Matrix", "Matrice des poids"),
"BoxWeightBar" = c("Weight Histogram", "Histogramme des poids"),
# Results box
"BoxResult" = c("Results", "Résultats"),
"BoxResultPerUnit" = c("Per unit", "Par unité"),
"SIRiskLevel" = c("Risk level", "Niveau 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)
}
inst/interface/server.R
View file @ a9b1ff61
This diff is collapsed.
inst/interface/ui.R
View file @ a9b1ff61
################### 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,
uiOutput("unitNameText"),
box(title = uiOutput("unitMapTextUI"), status = "primary", width = 6, solidHeader = TRUE,
# Display map
plotOutput("unitMapDisplay")
rHandsontableOutput("rhWeightTable")#,
),
box(title = uiOutput("unitStatTextUI"), status = "success", width = 6, solidHeader = TRUE,
# actionButton(inputId = "abWMatrixOK", label = "Valider"),
#
# textOutput("isMatrixOKText")
# Display statistics
textOutput("unitStatText"),
plotOutput("unitStatDisplay")
),
box(
status = "info",
width = 3,
solidHeader = FALSE,
)
),
# Risk factors
tabItem("riskTab",
uiOutput("uiRiskLayerList"),
box(title = uiOutput("riskRawMapTextUI"), status = "primary", width = 6, solidHeader = TRUE,