Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Maintenance - Mise à jour mensuelle Lundi 6 Février entre 7h00 et 9h00
Open sidebar
UMR-ASTRE
mapMCDA
Commits
a9b1ff61
Commit
a9b1ff61
authored
Apr 08, 2019
by
Sylvain Falala
Browse files
new structure of code of interface
Use shinyFiles
parent
169ffc4d
Changes
3
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
201
8
, by Sylvain Falala, Unit CIRAD-INRA ASTRE
#
Interface for
mapMCDA
project
#
April
201
9
, 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."
,
"
Signal
er la couche d'unités épidémiologiques."
"
Indiqu
er la couche d'unités épidémiologiques."
)
langHelpScale
<-
c
(
...
...
@@ -97,194 +122,4 @@ langHelpMatrix <- c(
)
# Epidemiological unit
langMenuUnit
<-
c
(
"Epidemiological units"
,
"Unités épidé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é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é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.
Click to expand it.
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 unit
s
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
,