Nothing
if (!requireNamespace("shinyFiles", quietly = TRUE)) {
stop("shinyFiles package is needed for the Global User Interface. Please install it.")
}
library(shinydashboard)
library(shinyFiles)
library(raster)
library(ggplot2)
serverWD <- function(working.directory){
function(input, output, session) {
### Server data ###
data <- reactiveValues(Env = stack(), Occ = data.frame(), dir = getwd(), ESDM = NULL, esdms = list(), Stack = NULL)
result <- reactiveValues(ESDM = NULL)
### Menu ###
output$menu <- renderMenu({
sidebarMenu(
id = 'actions',
menuItem('Welcome page', tabName = 'welcomepage',selected=TRUE),
menuItem('Load',
menuSubItem('New data', tabName = 'newdata'),
menuSubItem('Previous model', tabName = 'previousmodel')
),
if(length(data$Occ) > 0) {
menuItem('Modelling',
menuSubItem('Modelling tab', 'modelling'),
selectInput('modellingchoice', 'Modelling type ',
c('Algorithm modelling', 'Ensemble modelling', 'Stack modelling'),
selected = 'Stack modelling')
)
},
if(length(data$Env) > 0 & any(length(data$Stack) > 0, length(data$ESDM) > 0)){
menuItem('Model forecasting',tabName='forecasting')
},
if(!is.null(data$Stack) || !is.null(data$ESDM)) {
if(inherits(data$ESDM,'Algorithm.SDM')) {tabname = 'Algorithm SDM'} else {tabname = 'Ensemble SDM'}
menuItem('Results',
if(!is.null(data$Stack)){menuItem("SSDM", tabName = "stack", icon = icon("dashboard"))},
menuItem(tabname, tabName = "stackesdm", icon = icon("pagelines")),
if(!is.null(data$Stack)){selectInput('esdmchoice', 'Species:', data$esdms, selectize = TRUE)},
if(!inherits(data$ESDM,'Algorithm.SDM')) {menuItem('Save model', tabName = "save", icon = icon("floppy-o"))},
if(!is.null(data$ESDM) | !is.null(data$Stack)) {
menuItem('Save maps', tabName = "savem", icon = icon("floppy-o"))
}
)
},
menuItem('Quit', tabName = 'quitpage')
)
})
### Load Menu ###
## Load new data page ##
# Environmental variable loading
load.var <- reactiveValues(factors = c(), formats = c(), norm = TRUE, vars = list())
# working.directory <- get("working.directory", envir = .GlobalEnv)
example = system.file("extdata", package = "SSDM")
if(Sys.info()[['sysname']] == 'Linux') {
shinyFileChoose(input, 'envfiles', session=session,
roots=c(wd = working.directory,
example = example,
home = '/home',
root = '/'),
filetypes=c('',"grd", "tif", "asc","sdat", "rst", "nc", "tif", "envi", "bil", "img"))
} else if (Sys.info()[['sysname']] == 'Windows') {
d = system('wmic logicaldisk get caption', intern = TRUE)
disks = c()
for(i in 2:(length(d)-1)){
disks = c(disks, substr(d[i],1,2))
}
names(disks) = disks
shinyFileChoose(input, 'envfiles', session=session,
roots=c(wd = working.directory,
example = example,
disks),
filetypes=c('',"grd", "tif", "asc","sdat", "rst", "nc", "tif", "envi", "bil", "img"))
} else {
shinyFileChoose(input, 'envfiles', session=session,
roots = c(wd = working.directory,
example = example,
home = '/user',
root = '/'),
filetypes=c('',"grd", "tif", "asc","sdat", "rst", "nc", "tif", "envi", "bil", "img"))
}
observeEvent(input$envfiles,{
if(!is.integer(input$envfiles)){
load.var$vars = lapply(input$envfiles$files, function(x) x[[length(x)]])
names(load.var$vars) <- unlist(load.var$vars)
}
})
output$envnames <- renderTable({
matrix(names(data$Env),dimnames=list(c(1:length(names(data$Env))),c("Selected data")))
})
output$factors <- renderUI({
selectInput('factors', 'Categorical', load.var$vars, multiple = TRUE, selectize = TRUE)
})
observeEvent(input$load, {
validate(
need(length(load.var$vars) > 0, 'Choose environment variable files first !')
)
if(Sys.info()[['sysname']] == 'Linux') {
path = switch(input$envfiles$root,
'wd' = working.directory,
'example' = example,
'home' = '/home',
'root' = '/')
} else if (Sys.info()[['sysname']] == 'Windows') {
path = switch(input$envfiles$root,
'wd' = working.directory,
'example' = example,
input$envfiles$root)
} else {
path = switch(input$envfiles$root,
'wd' = working.directory,
'example' = example,
'home' = '/home',
'root' = '/')
}
for(i in 2:(length(input$envfiles$files[[1]]))-1){
path = paste0(path, '/', input$envfiles$files[[1]][i])
}
load.var$formats = c()
for (i in seq_len(length(load.var$vars))) {
format = paste0('.',strsplit(load.var$vars[[i]], '.', fixed = TRUE)[[1]][2])
if (!(format %in% load.var$formats)) {load.var$formats = c(load.var$formats, format)}
}
if('Normalization' %in% input$load.var.options) {
load.var$norm = TRUE
} else {
load.var$norm = FALSE
}
a = try(withProgress(message = 'Variables loading',
load_var(path,
files = unlist(load.var$vars),
format = load.var$formats,
Norm = load.var$norm,
tmp = FALSE,
categorical = load.var$factors,
verbose = FALSE,
GUI = TRUE)))
if(inherits(a, 'try-error')){
output$Envbug <- renderUI(p('Environmental variables loading failed, please check your inputs and try again'))
} else {
output$Envbug <- renderUI(p())
data$Env = a
for (i in seq_len(length(load.var$vars))) {
names(data$Env)[i] = strsplit(load.var$vars[[i]], '.', fixed = TRUE)[[1]][1]
}
output$layerchoice <- renderUI({
selectInput('layer', 'Variable', as.list(names(data$Env)), multiple = FALSE, selectize = TRUE)
})
output$env <- leaflet::renderLeaflet({
if(!is.null(input$layer)){
i = as.numeric(which(as.list(names(data$Env)) == input$layer))
if(data$Env[[i]]@data@isfactor) {
map = !as.factor(data$Env[[i]])
} else {
map = data$Env[[i]]
}
pal <- leaflet::colorNumeric(rev(terrain.colors(1000)),
values(map), na.color = "transparent")
leaflet::leaflet() %>%
leaflet::addTiles() %>%
leaflet::addRasterImage(map, colors = pal, opacity = 0.8) %>%
leaflet::addLegend(pal = pal, values = values(map), title = "Diversity")
}
})
}
updateTabItems(session, "actions", selected = "newdata")
})
# Occurrences loading
load.occ <- reactiveValues(columns = c())
if(Sys.info()[['sysname']] == 'Linux') {
shinyFileChoose(input, 'Occ', session=session,
roots = c(wd = working.directory,
example = example,
home = '/home',
root = '/'),
filetypes=c('',"csv", "txt"))
} else if (Sys.info()[['sysname']] == 'Windows') {
d = system('wmic logicaldisk get caption', intern = TRUE)
disks = c()
for(i in 2:(length(d)-1)){
disks = c(disks, substr(d[i],1,2))
}
names(disks) = disks
shinyFileChoose(input, 'Occ', session=session,
roots = c(wd = working.directory,
example = example,
disks),
filetypes=c('',"csv", "txt"))
} else {
shinyFileChoose(input, 'Occ', session=session,
roots = c(wd = working.directory,
example = example,
home = '/user',
root = '/'),
filetypes=c('',"csv", "txt"))
}
observeEvent(input$Occ, {
if(!is.integer(input$Occ)) {
file = paste0(switch(input$Occ$root,
'wd' = working.directory,
'example' = example,
'home' = '/home',
'root' = '/',
input$Occ$root), '/', paste0(unlist(input$Occ$files[[1]])[-1], collapse = '/'))
load.occ$columns = names(read.csv2(file))
}
})
observeEvent(input$sep, {
if(!is.integer(input$Occ)) {
file = paste0(switch(input$Occ$root,
'wd' = working.directory,
'example' = example,
'home' = '/home',
'root' = '/',
input$Occ$root), '/', paste0(unlist(input$Occ$files[[1]])[-1], collapse = '/'))
load.occ$columns = names(read.csv2(file, sep = input$sep, nrows = 0))
}
})
observeEvent(input$Occ, {
if(!is.integer(input$Occ)) {
file = paste0(switch(input$Occ$root,
'wd' = working.directory,
'example' = example,
'home' = '/home',
'root' = '/',
input$Occ$root), '/', paste0(unlist(input$Occ$files[[1]])[-1], collapse = '/'))
load.occ$columns = names(read.csv2(file, sep = input$sep, nrows = 0))
}
})
output$Xcol <- renderUI({selectInput('Xcol', 'X column', load.occ$columns, multiple = FALSE)})
output$Ycol <- renderUI({selectInput('Ycol', 'Y column', load.occ$columns, multiple = FALSE)})
output$Pcol <- renderUI({selectInput('Pcol', 'Presence (1) / absence (0) column', c('None', load.occ$columns), multiple = FALSE)})
output$Spcol <- renderUI({selectInput('Spcol', 'Species column', c('None', load.occ$columns), multiple = FALSE)})
output$reso <- renderUI({if(input$GeoRes){sliderInput('reso', 'Resampling grid coefficient', 1,10,1)}})
observeEvent(input$load2, {
validate(
need(length(data$Env@layers) > 0, 'You need to load environmental variable before !'),
need(length(input$Occ) > 0, 'Choose occurrences file first !')
)
if(is.null(input$dec)) {dec = ","} else {dec = input$dec}
if (input$Spcol == 'None') {Spcol = NULL} else {Spcol = input$Spcol}
if(is.null(input$sep)) {sep = ""} else {sep = input$sep}
file = paste0(switch(input$Occ$root,
'wd' = working.directory,
'example' = example,
'home' = '/home',
'root' = '/',
input$Occ$root), '/', paste0(unlist(input$Occ$files[[1]])[-1], collapse = '/'))
a = try(withProgress(message = 'Occurrences loading',
load_occ(path = {},
data$Env,
file,
Xcol = input$Xcol,
Ycol = input$Ycol,
Spcol = Spcol,
GeoRes = input$GeoRes,
reso = max(res(data$Env@layers[[1]])) * as.numeric(input$reso),
verbose = FALSE,
GUI = TRUE,
sep = sep,
dec = dec)))
if(inherits(a, 'try-error')){
output$Occbug <- renderUI(p('Occurrences loading failed, please check your inputs and try again'))
} else {
output$Occbug <- renderUI(p(' '))
data$Occ = a
}
updateTabItems(session, "actions", selected = "newdata")
})
output$occ <- renderDataTable({if(length(data$Occ) > 0) {data$Occ}})
## Load previous model page ##
if(Sys.info()[['sysname']] == 'Linux') {
shinyDirChoose(input, 'prevmodel', session=session,
roots = c(wd = working.directory,
home = '/home',
root = '/'),
filetypes=c(''))
} else if (Sys.info()[['sysname']] == 'Windows') {
d = system('wmic logicaldisk get caption', intern = TRUE)
disks = c()
for(i in 2:(length(d)-1)){
disks = c(disks, substr(d[i],1,2))
}
names(disks) = disks
shinyDirChoose(input, 'prevmodel', session=session,
roots = c(wd = working.directory,
disks),
filetypes=c(''))
} else {
shinyDirChoose(input, 'prevmodel', session=session,
roots = c( wd= working.directory,
home = '/user',
root = '/'),
filetypes=c(''))
}
observeEvent(input$load.model, {
validate(
need(input$model.type != ' ', 'You need to choose the model type first !')
)
if(Sys.info()[['sysname']] == 'Linux') {
path = switch(input$prevmodel$root,
'wd' = working.directory,
'home' = '/home/',
'root' = '/')
} else if (Sys.info()[['sysname']] == 'Windows') {
path = switch(input$prevmodel$root, 'wd' = working.directory, input$prevmodel$root)
} else {
path = switch(input$prevmodel$root,
'wd' = working.directory,
'home' = '/home',
'root' = '/')
}
for(i in 2:(length(input$prevmodel$path)-1)){
path = paste0(path, '/', input$prevmodel$path[[i]][1])
}
name = input$prevmodel$path[[length(input$prevmodel$path)]][1]
if (input$model.type == 'Ensemble SDM') {
a = try(load_esdm(name, path))
}
if (input$model.type == 'SSDM') {
a = try(withProgress(message = 'Model loading', load_stack(name, path, GUI = TRUE)))
}
if(inherits(a, 'try-error')){
output$prevmodelbug <- renderText('Previous model loading failed, please check your inputs and try again')
} else {
output$prevmodelbug <- renderText(' ')
if (input$model.type == 'Ensemble SDM') {
data$ESDM = a
if(!is.null(data$ESDM)){result$ESDM = data$ESDM}
output$model.preview <- leaflet::renderLeaflet({
diversity <- data$ESDM@projection
pal <- leaflet::colorNumeric(rev(terrain.colors(1000)),
values(diversity), na.color = "transparent")
leaflet::leaflet() %>%
leaflet::addTiles() %>%
leaflet::addRasterImage(diversity, colors = pal, opacity = 0.8) %>%
leaflet::addLegend(pal = pal, values = values(diversity), title = "Diversity")
})
}
if (input$model.type == 'SSDM') {
data$Stack = a
for (i in seq_len(length(names(data$Stack@esdms)))) {data$esdms[[i]] = strsplit(names(data$Stack@esdms), '.Ensemble.SDM', fixed = TRUE)[[i]][1]}
output$model.preview <- leaflet::renderLeaflet({
diversity <- data$Stack@diversity.map
pal <- leaflet::colorNumeric(rev(terrain.colors(1000)),
values(diversity), na.color = "transparent")
leaflet::leaflet() %>%
leaflet::addTiles() %>%
leaflet::addRasterImage(diversity, colors = pal, opacity = 0.8) %>%
leaflet::addLegend(pal = pal, values = values(diversity), title = "Diversity")
})
}
}
})
## Basic modelling parameters ##
output$species <-renderUI({
if(input$modellingchoice != 'Stack modelling'){
if (input$Spcol != 'None') {
selectInput('species', 'Species', as.list(levels(data$Occ[,which(names(data$Occ) == input$Spcol)])))
}
}
})
output$algoUI <- renderUI({
if(input$modellingchoice == 'Algorithm modelling'){
title = 'Algorithm'
multiple = FALSE
} else {
title = 'Algorithms'
multiple = TRUE
}
selectInput('algo', title, c('GLM','GAM','MARS','GBM','CTA','RF','MAXENT','ANN','SVM'), multiple = multiple, selectize = TRUE)})
output$repUI <- renderUI({if(input$modellingchoice != 'Algorithm modelling'){sliderInput('rep','Repetitions',1,50,10, step = 1)}})
output$nameUI <- renderUI({textInput('name','Name')})
output$uncertUI <- renderUI({if(input$modellingchoice != 'Algorithm modelling'){checkboxInput('uncert', 'Uncertainty mapping', value = TRUE)}})
output$uncertinfoUI <- renderUI({if(input$modellingchoice != 'Algorithm modelling'){p('Between-algorithm variance map')}})
output$endemismUI <- renderUI({if(input$modellingchoice == 'Stack modelling'){selectInput('endemism', 'Endemism mapping', c('None', 'WEI', 'CWEI'), selected = 'WEI')}})
output$endemisminfoUI <- renderUI({
if(input$modellingchoice == 'Stack modelling'){
if(length(input$endemism) == 1) {
p(switch(input$endemism,
'None' = 'No endemism map will be built',
'WEI' = 'Endemism map will be built by counting all species in each cell and weighting each by the inverse of its number of occurrences',
'CWEI' = 'Endemism map will be built by dividing the weighted endemism index by the total count of species in the cell')
)
}
}
})
output$endemismrangeUI <- renderUI({
if(input$modellingchoice == 'Stack modelling'){
if(length(input$endemism) == 1) {
if(input$endemism != 'None'){
selectInput('endemismrange', 'Range in endemism mapping', c('NbOcc', 'Binary'), selected = 'Binary')
}
}
}
})
output$endemismrangeinfoUI <- renderUI({if(input$modellingchoice == 'Stack modelling'){
if(length(input$endemismrange) == 1) {
p(switch(input$endemismrange,
'NbOcc' = 'Range in endemism index computing is the total number of occurrences.',
'Binary' = 'Range in endemism index comuting is the surface of the binary map species distribution.'))}}})
output$metricUI <- renderUI({selectInput('metric', 'Evaluation metric', c('Kappa','CCR','TSS','SES','LW','ROC'), selected = 'SES')})
output$metricinfoUI <- renderUI({
if(length(input$metric) == 1) {
p(switch(input$metric,
'Kappa' = 'Maximizes the Kappa',
'CCR' = 'Maximizes the sum of sensitivity and specificity',
'TSS' = '(True Skill Statistic) maximizes the sum of sensitivity and specificity',
'SES' = 'Uses the sensitivity-specificity equality',
'LW' = 'Uses the lowest occurrence prediction probability',
'ROC' = 'Minimizes the distance between the ROC plot (receiving operating curve) and the upper left corner (1,1).'))
}})
output$methodUI <- renderUI({
if(input$modellingchoice == 'Stack modelling'){
selectInput('method', 'Diversity mapping method',
c('pSSDM','Bernoulli','bSSDM','MaximumLikelihood','PRR.MEM','PRR.pSSDM'),
selected = 'Probability')
}
})
output$methodinfoUI <- renderUI({
if(input$modellingchoice == 'Stack modelling'){
if(length(input$method) == 1) {
p(switch(input$method,
'pSSDM' = 'Sum probabilities of habitat suitability maps',
'Bernoulli' = 'Drawing repeatedly from a Bernoulli distribution',
'bSSDM' = 'Sum the binary map obtained with the thresholding (depending on the metric, see metric parameter)',
'MaximumLikelihood' = 'Adjust species richness of the model by linear regression',
'PRR.MEM' = 'Model richness with a macroecological model (MEM) and adjust each ESDM binary map by ranking habitat suitability and keeping as much as predicted richness of the MEM',
'PRR.pSSDM' = 'Model richness with a pSSDM and adjust each ESDM binary map by ranking habitat suitability and keeping as much as predicted richness of the pSSDM'))
}
}
})
output$repBslide <- renderUI({if(input$modellingchoice == 'Stack modelling'){if(!is.null(input$method)){if(input$method=='Random Bernoulli'){sliderInput('repB','Bernoulli repetitions',1,10000,1000, step = 1)}}}})
## Intermediate modelling parameters ##
output$PAnbUI <- renderUI(if(!input$PA){sliderInput('PAnb','PA number',1,10000,1000, step = 100)})
output$PAstratUI <- renderUI(if(!input$PA){selectInput('PAstrat', 'PA strategy', c('random','disk'), selected = 'random')})
output$cvalinfoUI <- renderUI({
p(switch(input$cval,
'holdout' = 'Data are partitioned into a training set and an evaluation set using a fraction and the operation can be repeated',
'k-fold' = 'Data are partitioned into k folds being k-1 times in the training set and once the evaluation set and the operation can be repeated',
'LOO' = '(Leave One Out) each point is successively taken as evaluation data'))
})
output$cvalparam1UI <- renderUI({
if(input$cval == 'holdout'){
title = 'Holdout fraction'
min = 0
max = 1
val = 0.7
step = 0.05
}
if(input$cval == 'k-fold'){
title = 'K fold number'
min = 1
max = 50
val = 10
step = 1
}
if(input$cval != 'LOO'){sliderInput('cvalparam1', title, min, max, val, step)}
})
output$cvalparam2UI <- renderUI({if(input$cval != 'LOO'){sliderInput('cvalrep', 'Cross-validation repetitions', 1,20,1, step = 1)}})
output$axesmetricinfoUI <- renderUI({
p(paste('Metric used to evaluate the variable relative importance (difference between a full model and one with each variable successively omitted):',
switch(input$axesmetric,
'Pearson' = 'Computes a simple Pearson\'s correlation r between predictions of the full model and the one without a variable, and returns the score 1-r: the highest the value, the more influence the variable has on the model',
'AUC' = 'Area under the receiving operating characteristic curve',
'Kappa' = 'Kappa',
'sensitivity' = 'Sensitivity',
'specificity' = 'Specificity',
'prop.correct' = 'Proportion of correctly predicted occurrences')))
})
output$ensemblemetricUI <- renderUI({if(input$modellingchoice != 'Algorithm modelling'){selectInput('ensemblemetric', 'Ensemble selection metric', c('AUC','Kappa','sensitivity','specificity','prop.correct'), selected = 'AUC', multiple = TRUE, selectize = TRUE)}})
output$ensembleinfoUI <- renderUI({if(input$modellingchoice != 'Algorithm modelling'){p('Metric(s) and threshold(s) used to select the best SDMs that will be kept in the ensemble SDM')}})
output$AUCUI <- renderUI({if(input$modellingchoice != 'Algorithm modelling'){if('AUC' %in% input$ensemblemetric){sliderInput('AUC','AUC threshold',0.5,1,0.75, step = 0.05)}}})
output$KappaUI <- renderUI({if(input$modellingchoice != 'Algorithm modelling'){if('Kappa' %in% input$ensemblemetric){sliderInput('Kappa','Kappa threshold',0,1,0.5, step = 0.05)}}})
output$sensitivityUI <- renderUI({if(input$modellingchoice != 'Algorithm modelling'){if('sensitivity' %in% input$ensemblemetric){sliderInput('sensitivity','Sensitivity threshold',0.5,1,0.75, step = 0.05)}}})
output$specificityUI <- renderUI({if(input$modellingchoice != 'Algorithm modelling'){if('specificity' %in% input$ensemblemetric){sliderInput('specificity','Specificity threshold',0.5,1,0.75, step = 0.05)}}})
output$propcorrectUI <- renderUI({if(input$modellingchoice != 'Algorithm modelling'){if('prop.correct' %in% input$ensemblemetric){sliderInput('propcorrect','Correct proportion threshold',0.5,1,0.75, step = 0.05)}}})
output$weightUI <- renderUI({if(input$modellingchoice != 'Algorithm modelling'){checkboxInput('weight', 'Ensemble weighted', value = TRUE)}})
output$rangeUI <- renderUI({if(input$modellingchoice == 'Stack modelling'){checkboxInput('range', 'Range restriction', value = FALSE)}})
output$rangevalUI <- renderUI({
if(is.logical(input$range)){
if(input$modellingchoice == 'Stack modelling' && input$range){
sliderInput('rangeval', 'Range restriction value', 1,100,5, step = 1)
}
}
})
output$rangeinfoUI <- renderUI({
if(is.logical(input$range)){
if(input$modellingchoice == 'Stack modelling' && input$range){
p('Set a value of range restriction (in pixels) around presence occurrences on habitat suitability maps (all further points will have a null probability)')
}
}
})
## Advanced modelling parameters ##
output$tmpUI <- renderUI({if(input$modellingchoice != 'Algorithm modelling'){checkboxInput('tmp', 'Temporary files', value = FALSE)}})
output$tmpinfoUI <- renderUI({if(input$modellingchoice != 'Algorithm modelling'){p('Rasters are saved in temporary files to release memory')}})
output$testUI <- renderUI({if('GLM' %in% input$algoparam || 'GAM' %in% input$algoparam){selectInput('test','Test (GLM/GAM)',c('AIC', 'BIC'))}})
output$epsilonUI <- renderUI({if('GLM' %in% input$algoparam || 'GAM' %in% input$algoparam || 'SVM' %in% input$algoparam){sliderInput('epsilon','Epsilon (GLM/GAM/SVM) = 1e-X',1,20,8, step = 1)}})
output$maxitUI <- renderUI({if('GLM' %in% input$algoparam || 'GAM' %in% input$algoparam || 'ANN' %in% input$algoparam){sliderInput('maxit','Maximum number of iterations (GLM/GAM/ANN)',100,1000,500, step = 100)}})
output$degreeUI <- renderUI({if('MARS' %in% input$algoparam){sliderInput('degree','Degree of interaction (MARS)',1,10,2, step = 1)}})
output$threshshrinkUI <- renderUI({if('GBM' %in% input$algoparam){sliderInput('threshshrink','Shrinkage threshold (GBM)',1e-05,1,1e-03, step = 1e-04)}})
output$treesUI <- renderUI({if('GBM' %in% input$algoparam || 'RF' %in% input$algoparam){sliderInput('trees','Maximum number of trees (GBM/RF)',500,10000,2500, step = 500)}})
output$finalleaveUI <- renderUI({if('GBM' %in% input$algoparam || 'RF' %in% input$algoparam || 'CTA' %in% input$algoparam){sliderInput('finalleave','Final leaves size (GBM/CTA/RF)',1,20,1, step = 1)}})
output$cvUI <- renderUI({if('GBM' %in% input$algoparam || 'CTA' %in% input$algoparam || 'SVM' %in% input$algoparam){sliderInput('cv','Cross-validation number (GBM/CTA/SVM)',1,20,3, step = 1)}})
## Modelling ##
observeEvent(input$model,{
validate(
need(length(input$algo) > 0, 'Choose algorithm(s) to be run !')
)
data$ESDM = NULL
data$Stack = NULL
data$esdms = list()
result$ESDM = NULL
output$modelprev = renderPlot({plot.new()})
output$modelfailed = renderText({''})
if (input$Pcol == 'None') {Pcol = NULL} else {Pcol = input$Pcol}
if (input$Spcol == 'None') {Spcol = NULL} else {Spcol = input$Spcol}
if (input$name == "") {name = NULL} else {name = input$name}
algo = c()
for (i in seq_len(length(input$algo))) {algo = c(algo, input$algo[i])}
if(!is.null(input$PA)) {PA = TRUE}
if(input$PA) {PA = NULL} else {PA = list('nb' = input$PAnb, 'strat' = input$PAstrat)}
if(is.null(input$ensemblemetric)){
ensemble.metric = c('AUC')
ensemble.thresh = c(0.75)
} else {
ensemble.metric = c()
ensemblethresh = c(input$AUC, input$Kappa, input$sensitivity, input$specificity, input$propcorrect)
ensemble.thresh = c()
for (i in seq_len(length(input$ensemblemetric))) {
ensemble.metric = c(ensemble.metric, input$ensemblemetric[i])
ensemble.thresh = c(ensemble.thresh, as.numeric(ensemblethresh[i]))
}
}
if(is.null(input$range) || !input$range) {range = NULL} else {range = input$rangeval}
if(is.null(input$endemism) || input$endemism == 'None') {endemism = NULL} else {endemism = c(input$endemism, input$endemismrange)}
algoparam = list()
if('GLM' %in% input$algoparam || 'GAM' %in% input$algoparam){algoparam$test = input$test} else {algoparam$test = 'AIC'}
if('GLM' %in% input$algoparam || 'GAM' %in% input$algoparam || 'SVM' %in% input$algoparam){algoparam$epsilon = as.numeric(paste0('1e-', as.character(input$epsilon)))} else {algoparam$epsilon = 1e-08}
if('GLM' %in% input$algoparam || 'GAM' %in% input$algoparam || 'ANN' %in% input$algoparam){algoparam$maxit = as.numeric(input$maxit)} else {algoparam$maxit = 500}
if('MARS' %in% input$algoparam){algoparam$degree = as.numeric(input$degree)} else {algoparam$degree = 3}
if('GBM' %in% input$algoparam){algoparam$thresh.shrink = as.numeric(input$threshshrink)} else {algoparam$threshshrink = 1e-03}
if('GBM' %in% input$algoparam || 'RF' %in% input$algoparam){algoparam$trees = as.numeric(input$trees)} else {algoparam$trees = 2500}
if('GBM' %in% input$algoparam || 'RF' %in% input$algoparam || 'CTA' %in% input$algoparam){algoparam$final.leave = as.numeric(input$finalleave)} else {algoparam$finalleave = 1}
if('GBM' %in% input$algoparam || 'CTA' %in% input$algoparam || 'SVM' %in% input$algoparam){algoparam$cv = as.numeric(input$cv)} else {algoparam$cv = 3}
if(is.null(input$repB)) {rep.B = 1000} else {rep.B = as.numeric(input$repB)}
if(is.null(input$cval)) {cval = 'holdout'} else {cval = input$cval}
if(length(c(as.numeric(input$cvalparam1), as.numeric(input$cvalrep))) < 2) {cv.param = c(0.7, 1)} else {cv.param = c(as.numeric(input$cvalparam1), as.numeric(input$cvalrep))}
if(!inherits(input$tmp,'logical')) {tmp = FALSE} else {tmp = input$tmp}
if(!inherits(input$weight,'logical')) {weight = TRUE} else {weight = input$weight}
if(input$modellingchoice == 'Algorithm modelling'){
if (input$Spcol != 'None') {
Occ = data$Occ[which(data$Occ[,which(names(data$Occ) == input$Spcol)] == input$species),]
} else {
Occ = data$Occ
}
data$ESDM = withProgress(message = 'SDM',
modelling(algo,
Occ, data$Env,
Xcol = input$Xcol,
Ycol = input$Ycol,
Pcol = Pcol,
name = name,
save = FALSE,
path = 'nowhere',
PA = PA,
cv = cval,
cv.param = cv.param,
thresh = as.numeric(input$thresh),
axes.metric = input$axesmetric,
select.metric = c('AUC'),
select.thresh = c(0),
select = FALSE,
metric = input$metric,
verbose = FALSE,
GUI = TRUE,
test = algoparam$test,
maxit = algoparam$maxit,
epsilon = algoparam$epsilon,
degree = algoparam$degree,
threshshrink = algoparam$threshshrink,
trees = algoparam$trees,
finalleave = algoparam$finalleave,
algocv = algoparam$cv))
output$modelprev = renderPlot(spplot(data$ESDM@projection,
main = 'Habitat suitability map',
xlab = 'Longitude (\u02DA)',
ylab = 'Latitude (\u02DA)',
col.regions = rev(terrain.colors(10000))))
result$ESDM = data$ESDM
}
if(!inherits(input$uncert,'logical')) {uncert = TRUE} else {uncert = input$uncert}
if(input$modellingchoice == 'Ensemble modelling'){
if (input$Spcol != 'None') {
Occ = data$Occ[which(data$Occ[,which(names(data$Occ) == input$Spcol)] == input$species),]
} else {
Occ = data$Occ
}
data$ESDM = withProgress(message = 'Ensemble SDM',
ensemble_modelling(algo,
Occ, data$Env,
Xcol = input$Xcol,
Ycol = input$Ycol,
Pcol = Pcol,
rep = as.numeric(input$rep),
name = name,
save = FALSE,
path = 'nowhere',
PA = PA,
cv = cval,
cv.param = cv.param,
thresh = as.numeric(input$thresh),
axes.metric = input$axesmetric,
uncertainty = uncert,
tmp = tmp,
ensemble.metric = ensemble.metric,
ensemble.thresh = ensemble.thresh,
weight = weight,
metric = input$metric,
verbose = FALSE,
GUI = TRUE,
test = algoparam$test,
maxit = algoparam$maxit,
epsilon = algoparam$epsilon,
degree = algoparam$degree,
threshshrink = algoparam$threshshrink,
trees = algoparam$trees,
finalleave = algoparam$finalleave,
algocv = algoparam$cv))
if(!is.null(data$ESDM)){
output$modelprev = leaflet::renderLeaflet({
diversity <- data$ESDM@projection
pal <- leaflet::colorNumeric(rev(terrain.colors(1000)),
values(diversity), na.color = "transparent")
leaflet::leaflet() %>%
leaflet::addTiles() %>%
leaflet::addRasterImage(diversity, colors = pal, opacity = 0.8) %>%
leaflet::addLegend(pal = pal, values = values(diversity), title = "Habitat\nsuitability")
})
result$ESDM = data$ESDM
} else {
output$modelfailed = renderText('No ensemble SDM were kept, maybe you should try lower ensemble threshold(s) ?')
}
}
if(requireNamespace("parallel", quietly = TRUE)){
cores = parallel::detectCores() - 1
} else {
cores = 1
}
if(input$modellingchoice == 'Stack modelling'){
data$Stack = withProgress(message = 'SSDM',
stack_modelling(algo,
data$Occ, data$Env,
Xcol = input$Xcol,
Ycol = input$Ycol,
Pcol = Pcol,
Spcol = Spcol,
rep = as.numeric(input$rep),
name = name,
save = FALSE,
path = 'nowhere',
PA = PA,
cv = cval,
cv.param = cv.param,
thresh = as.numeric(input$thresh),
axes.metric = input$axesmetric,
uncertainty = uncert,
tmp = tmp,
ensemble.metric = ensemble.metric,
ensemble.thresh = ensemble.thresh,
weight = weight,
method = input$method,
metric = input$metric,
rep.B = rep.B,
range = range,
endemism = endemism,
verbose = FALSE,
GUI = TRUE,
cores = 0,
test = algoparam$test,
maxit = algoparam$maxit,
epsilon = algoparam$epsilon,
degree = algoparam$degree,
threshshrink = algoparam$threshshrink,
trees = algoparam$trees,
finalleave = algoparam$finalleave,
algocv = algoparam$cv))
if(!is.null(data$Stack)){
output$modelprev = leaflet::renderLeaflet({
diversity <- data$Stack@diversity.map
pal <- leaflet::colorNumeric(rev(terrain.colors(1000)),
values(diversity), na.color = "transparent")
leaflet::leaflet() %>%
leaflet::addTiles() %>%
leaflet::addRasterImage(diversity, colors = pal, opacity = 0.8) %>%
leaflet::addLegend(pal = pal, values = values(diversity), title = "Species\nrichness")
})
for (i in seq_len(length(names(data$Stack@esdms)))) {data$esdms[[i]] = strsplit(names(data$Stack@esdms), '.Ensemble.SDM', fixed = TRUE)[[i]][1]}
} else {
output$modelfailed = renderText('You have less than two remaining ensemble SDMs, maybe you should try lower ensemble threshold(s) ?')
}
}
})
## Stack results ##
output$Stackname <- renderUI(h2(data$Stack@name, align = 'center'))
output$diversity.title <- renderText({paste0('<b>Mean species richness error: ', round(data$Stack@evaluation['mean','species.richness.error'], 3), "<br>")})
output$Diversity <- leaflet::renderLeaflet({
map <- data$Stack@diversity.map
pal <- leaflet::colorNumeric(rev(terrain.colors(1000)),
values(map), na.color = "transparent")
leaflet::leaflet() %>%
leaflet::addTiles() %>%
leaflet::addRasterImage(map, colors = pal, opacity = 0.8) %>%
leaflet::addLegend(pal = pal, values = values(map), title = "Diversity")
})
output$endemism <- leaflet::renderLeaflet({
map<- data$Stack@endemism.map
pal <- leaflet::colorNumeric(rev(terrain.colors(1000)),
values(map), na.color = "transparent")
leaflet::leaflet() %>%
leaflet::addTiles() %>%
leaflet::addRasterImage(map, colors = pal, opacity = 0.8) %>%
leaflet::addLegend(pal = pal, values = values(map), title = "Endemism")
})
output$Uncertainity <- leaflet::renderLeaflet({
map <- data$Stack@uncertainty
pal <- leaflet::colorNumeric(rev(terrain.colors(1000)),
values(map), na.color = "transparent")
leaflet::leaflet() %>%
leaflet::addTiles() %>%
leaflet::addRasterImage(map, colors = pal, opacity = 0.8) %>%
leaflet::addLegend(pal = pal, values = values(map), title = "Uncertainty")
})
# Evaluation
output$evaluation.barplot <- renderPlot({
evaluation <- as.matrix(data$Stack@evaluation['mean',])
colnames(evaluation)[1:2] <- c('richness', 'success')
barplot(evaluation, col = rainbow(length(evaluation)), beside=TRUE)
})
output$evaluation.table <- renderTable({
evaluation <- data$Stack@evaluation
names(evaluation)[1:2] <- c('richness', 'success')
evaluation
})
# Algorithms correlation
output$algo.corr.table <- renderTable({data$Stack@algorithm.correlation})
output$algo.corr.heatmap <- renderPlot({
m <- as.matrix(data$Stack@algorithm.correlation)
ggplot(reshape2::melt(m, id.vars = NULL),
aes(Var1, Var2, fill = value, label = round(value, 2))) +
geom_tile() +
geom_text(col = "white") +
scale_fill_gradient(guide = "none", na.value = "white",
low = scales::muted("blue"), high = scales::muted("red")) +
theme_minimal() +
theme(axis.title = element_blank(),
axis.text.x = element_text(angle = 90))
})
# Variable importance
output$varimp.barplot <- renderPlot({
varimp = as.data.frame(t(data$Stack@variable.importance))
names(varimp) = 'Axes.evaluation'
bar = barplot(varimp$Axes.evaluation, names.arg = abbreviate(row.names(varimp)),
ylim = c(0,(max(varimp$Axes.evaluation)+max((varimp[2])))),
las = 2, ylab = 'Variable relative contribution (%)')
arrows(bar,varimp$Axes.evaluation+varimp[,2], bar, varimp$Axes.evaluation-varimp[,2], angle=90, code=3, length=0.1)
})
output$varimp.table <- renderTable({data$Stack@variable.importance})
output$varimplegend <- renderTable({data.frame('Abbreviation' = abbreviate(names(data$Stack@variable.importance)), 'Variable' = names(data$Stack@variable.importance))})
# Parameters
output$summary <- renderTable({
summary = data.frame(matrix(nrow = 7, ncol = 1))
names(summary) = 'Summary'
row.names(summary) = c('Occurrences type', 'Final number of species', 'Original algorithms', 'Number of repetitions',
'Pseudo-absences selection', 'Cross-validation method', 'Cross-validation parameters')
algo.info = character()
for (i in seq_len(length(strsplit(data$Stack@parameters$algorithms, '.', fixed = TRUE)[[1]][-1]))) {
algo.info = paste(algo.info, strsplit(data$Stack@parameters$algorithms, '.', fixed = TRUE)[[1]][-1][i])
}
if (data$Stack@parameters$PA) {PA = 'default'}
if(data$Stack@parameters$cv == 'LOO') {cv.param = 'None'}
if(data$Stack@parameters$cv == 'holdout') {cv.param = paste('fraction =',
strsplit(data$Stack@parameters$cv.param, '|', fixed = TRUE)[[1]][2],
'rep =',
strsplit(data$Stack@parameters$cv.param, '|', fixed = TRUE)[[1]][3])}
if(data$Stack@parameters$cv == 'k-fold') {cv.param = paste('k =',
strsplit(data$Stack@parameters$cv.param, '|', fixed = TRUE)[[1]][2],
'rep =',
strsplit(data$Stack@parameters$cv.param, '|', fixed = TRUE)[[1]][3])}
summary$Summary = c(data$Stack@parameters$data, length(data$Stack@esdms), algo.info, data$Stack@parameters$rep, PA, data$Stack@parameters$cv, cv.param)
if(!is.null(data$Stack@parameters$sp.nb.origin)) {
summary = rbind(summary,
data.frame(Summary = data$Stack@parameters$sp.nb.origin, row.names = 'Original number of species'))
}
summary
})
output$diversity.info <- renderText({
text = switch(data$Stack@parameters$method,
'P' = 'summing habitat suitability probabilities',
'T' = paste('summing habitat suitability binary maps after thresholding with',data$Stack@parameters$metric),
'B' = paste('drawing repeatdly from a Bernoulli distribution with',data$Stack@parameters$rep.B, 'repetitions'))
text = paste('Local species richness map realized by', text)
text
})
output$endemism.info <- renderText({
text = switch(data$Stack@parameters$endemism,
'Any' = 'Endemism map not built (unactivated)',
'WEI' = 'Endemism map built with the Weighted Endemism Index (WEI)',
'B' = 'Endemism map built with the Corrected Weighted Endemism Index (CWEI)')
text
})
output$varimp.info <- renderText({
if( data$Stack@parameters$axes.metric != 'Pearson') {
varimp.info = paste('Variable relative contribution evaluated with', data$Stack@parameters$axes.metric)
} else {
varimp.info = paste('Variable relative contribution evaluated with', data$Stack@parameters$axes.metric, '\'s correlation coefficient')
}
varimp.info
})
output$evaluation.info <- renderText({
evaluation.info = 'Evaluation of models with'
for (i in seq_len(length(strsplit(data$Stack@parameters$ensemble.metric, '.', fixed = TRUE)[[1]][-1]))) {
if (i == 1) {
evaluation.info = paste0(evaluation.info, ' ', strsplit(data$Stack@parameters$ensemble.metric, '.', fixed = TRUE)[[1]][-1][i],' (>',strsplit(data$Stack@parameters$ensemble.thresh, '|', fixed = TRUE)[[1]][-1][i],')')
} else if (i == length(data$Stack@parameters$axes.metric) && i != 1) {
evaluation.info = paste0(evaluation.info, ' and ', strsplit(data$Stack@parameters$ensemble.metric, '.', fixed = TRUE)[[1]][-1][i],' (>',strsplit(data$Stack@parameters$ensemble.thresh, '|', fixed = TRUE)[[1]][-1][i],')','.')
} else {
evaluation.info = paste0(evaluation.info, ', ', strsplit(data$Stack@parameters$ensemble.metric, '.', fixed = TRUE)[[1]][-1][i],' (>',strsplit(data$Stack@parameters$ensemble.thresh, '|', fixed = TRUE)[[1]][-1][i],')')
}
}
evaluation.info
})
## ESDM Stack Result ##
observeEvent(input$esdmchoice, {
if(!is.null(data$Stack)){
if(length(data$esdms) > 0){result$ESDM = data$Stack@esdms[[which(data$esdms == input$esdmchoice)]]}
}
})
output$probability.title <- renderText({
paste0('<b>AUC :', round(result$ESDM@evaluation$AUC,3),
' Kappa', round(result$ESDM@evaluation$Kappa,3), "<br>")
})
output$probability <- leaflet::renderLeaflet({
map <- result$ESDM@projection
obs <- data.frame(X = result$ESDM@data$X[which(result$ESDM@data$Presence == 1)],
Y = result$ESDM@data$Y[which(result$ESDM@data$Presence == 1)])
pal <- leaflet::colorNumeric(rev(terrain.colors(1000)),
values(map), na.color = "transparent")
leaflet::leaflet() %>%
leaflet::addTiles() %>%
leaflet::addRasterImage(map, colors = pal, opacity = 0.8) %>%
leaflet::addCircles(data = obs, lng = ~ X, lat = ~ Y, radius = 1) %>%
leaflet::addLegend(pal = pal, values = values(map), title = "Habitat\nsuitability")
})
output$niche <- leaflet::renderLeaflet({
map<- reclassify(result$ESDM@projection, c(-Inf,result$ESDM@evaluation$threshold,0, result$ESDM@evaluation$threshold,Inf,1))
pal <- leaflet::colorNumeric(rev(terrain.colors(1000)),
values(map), na.color = "transparent")
leaflet::leaflet() %>%
leaflet::addTiles() %>%
leaflet::addRasterImage(map, colors = pal, opacity = 0.8) %>%
leaflet::addLegend(pal = pal, values = values(map), title = "Niche")
})
output$esdm.uncertainty <- leaflet::renderLeaflet({
if(!inherits(result$ESDM,'Algorithm.SDM')) {
map <- result$ESDM@uncertainty
pal <- leaflet::colorNumeric(rev(terrain.colors(1000)),
values(map), na.color = "transparent")
leaflet::leaflet() %>%
leaflet::addTiles() %>%
leaflet::addRasterImage(map, colors = pal, opacity = 0.8) %>%
leaflet::addLegend(pal = pal, values = values(map), title = "Uncertainty")
}
})
# Evaluation
output$esdm.evaluation.barplot <- renderPlot({
evaluation = result$ESDM@algorithm.evaluation
if(!(0 %in% dim(evaluation))){
for (i in seq_len(length(row.names(result$ESDM@algorithm.evaluation)))) {row.names(evaluation)[i] = strsplit(as.character(row.names(result$ESDM@algorithm.evaluation)[i]), '.SDM')[[1]][1]}
for (i in seq_len(length(row.names(evaluation)))) {row.names(evaluation)[i] = tail(strsplit(as.character(row.names(evaluation)[i]), '.', fixed = TRUE)[[1]], n = 1)}
evaluation$kept.model = evaluation$kept.model / max(evaluation$kept.model)
table <- t(cbind(evaluation$AUC, evaluation$Kappa, evaluation$kept.model))
barplot(table, col=c("darkblue","red","green"), names.arg = row.names(evaluation), beside=TRUE)
legend('bottomright', c('AUC', 'Kappa','Kept model'), fill = c("darkblue","red","green"))
}
})
output$esdm.evaluation.table <- renderTable({
algo.eval = result$ESDM@algorithm.evaluation
if(!(0 %in% dim(algo.eval))){
for (i in seq_len(length(row.names(result$ESDM@algorithm.evaluation)))) {row.names(algo.eval)[i] = strsplit(as.character(row.names(result$ESDM@algorithm.evaluation)[i]), '.SDM')[[1]][1]}
for (i in seq_len(length(row.names(result$ESDM@algorithm.evaluation)))) {row.names(algo.eval)[i] = tail(strsplit(as.character(row.names(algo.eval)[i]), '.', fixed = TRUE)[[1]], n = 1)}
algo.eval[c(2,4:8)]
}
})
# Algorithms correlation
output$esdm.algo.corr.table <- renderTable({
correlation = result$ESDM@algorithm.correlation
for (i in seq_len(length(row.names(result$ESDM@algorithm.correlation)))) {row.names(correlation)[i] = strsplit(as.character(row.names(result$ESDM@algorithm.correlation)[i]), '.SDM')[[1]][1]}
names(correlation) = row.names(correlation)
if (length(correlation) > 0) {
correlation[upper.tri(correlation, diag = TRUE)] = NA
correlation
}
})
output$esdm.algo.corr.heatmap <- renderPlot({
correlation = result$ESDM@algorithm.correlation
for (i in seq_len(length(row.names(result$ESDM@algorithm.correlation)))) {row.names(correlation)[i] = strsplit(as.character(row.names(result$ESDM@algorithm.correlation)[i]), '.SDM')[[1]][1]}
names(correlation) = row.names(correlation)
if (length(correlation) > 0) {
correlation[upper.tri(correlation, diag = TRUE)] = NA
m <- as.matrix(correlation)
ggplot(reshape2::melt(m, id.vars = NULL),
aes(Var1, Var2, fill = value, label = round(value, 2))) +
geom_tile() +
geom_text(col = "white") +
scale_fill_gradient(guide = "none", na.value = "white",
low = scales::muted("blue"), high = scales::muted("red")) +
theme_minimal() +
theme(axis.title = element_blank(),
axis.text.x = element_text(angle = 90))
}
})
# Algo Eval Corr UI
output$algoevalcorr <- renderUI({
if(!inherits(result$ESDM,'Algorithm.SDM')) {
fluidRow(
tabBox(title = 'Model evaluation',
tabPanel(plotOutput('esdm.evaluation.barplot'),
textOutput('esdm.evaluation.info'),
title = 'Barplot'),
tabPanel(tableOutput('esdm.evaluation.table'), title = 'Table')
),
tabBox(title = 'Algorithm correlation',
tabPanel(plotOutput('esdm.algo.corr.heatmap'), title = 'Heatmap'),
tabPanel(tableOutput('esdm.algo.corr.table'), title = 'Table')
)
)
}
})
# Variable importance
output$esdm.varimp.barplot <- renderPlot({
varimp = as.data.frame(t(result$ESDM@variable.importance))
names(varimp) = 'Axes.evaluation'
barplot(varimp$Axes.evaluation, names.arg = abbreviate(row.names(varimp)), las = 2, ylab = 'Variable relative contribution (%)')
})
output$esdm.varimp.table <- renderTable({result$ESDM@variable.importance})
output$esdmvarimplegend <- renderTable({data.frame('Abbreviation' = abbreviate(names(result$ESDM@variable.importance)), 'Variable' = names(result$ESDM@variable.importance))})
# Parameters
output$esdm.summary <- renderTable({
if(!inherits(result$ESDM,'Algorithm.SDM')) {
summary = data.frame(matrix(nrow = 7, ncol = 1))
names(summary) = 'Summary'
row.names(summary) = c('Type of occurrences', 'Number of occurrences', 'Originally selected algorithms', 'Number of repetitions',
'Pseudo-absence selection method', 'Cross-validation method', 'Cross-validation parameters')
algo.info = character()
for (i in seq_len(length(strsplit(result$ESDM@parameters$algorithms, '.', fixed = TRUE)[[1]][-1]))) {
algo.info = paste(algo.info, strsplit(result$ESDM@parameters$algorithms, '.', fixed = TRUE)[[1]][-1][i])
}
if (result$ESDM@parameters$PA) {PA = 'default'}
if (result$ESDM@parameters$data == "presence-only data set") {
nb.occ = length(as.factor(result$ESDM@data$Presence[which(result$ESDM@data$Presence==1)])) / sum(result$ESDM@algorithm.evaluation$kept.model)
} else {
nb.occ = length(as.factor(result$ESDM@data$Presence)) / sum(result$ESDM@algorithm.evaluation$kept.model)
}
if(result$ESDM@parameters$cv == 'LOO') {cv.param = 'None'}
if(result$ESDM@parameters$cv == 'holdout') {cv.param = paste('fraction =',
strsplit(result$ESDM@parameters$cv.param, '|', fixed = TRUE)[[1]][2],
'rep =',
strsplit(result$ESDM@parameters$cv.param, '|', fixed = TRUE)[[1]][3])}
if(result$ESDM@parameters$cv == 'k-fold') {cv.param = paste('k =',
strsplit(result$ESDM@parameters$cv.param, '|', fixed = TRUE)[[1]][2],
'rep =',
strsplit(result$ESDM@parameters$cv.param, '|', fixed = TRUE)[[1]][3])}
summary$Summary = c(result$ESDM@parameters$data, nb.occ, algo.info, result$ESDM@parameters$rep, PA, result$ESDM@parameters$cv, cv.param)
if(!is.null(result$ESDM@parameters$sp.nb.origin)) {
summary = rbind(summary,
data.frame(Summary = result$ESDM@parameters$sp.nb.origin, row.names = 'Original number of species'))
}
summary
}
else {
data.frame('Not computed')
}
})
output$esdm.binary.info <- renderText({
metric = switch(result$ESDM@parameters$metric,
'Kappa' = 'maximizing the Kappa',
'CCR' = 'maximizing the proportion of correctly predicted occurrences (CCR)',
'TSS' = 'maximizing the sensitivity and specificity sum (TSS)',
'SES' = 'using the sensitivity and specificity equality',
'LW' = 'using the lowest occurrence prediction probability',
'ROC' = 'minimizing the distance between the ROC plot and the upper left corner')
text = paste('Binary map realized by', metric,
'with a final threshold of', round(result$ESDM@evaluation$threshold, digits = 3))
text
})
output$esdm.varimp.info <- renderText({
varimp.info = 'Variable relative contribution evaluated with '
for (i in seq_len(length(result$ESDM@parameters$axes.metric))) {
if (i == 1) {
varimp.info = paste(varimp.info, result$ESDM@parameters$axes.metric[i])
} else if (i == length(result$ESDM@parameters$axes.metric) && i != 1) {
varimp.info = paste(varimp.info, 'and', result$ESDM@parameters$axes.metric[i], '.')
} else {
varimp.info = paste(varimp.info, ',', result$ESDM@parameters$axes.metric[i])
}
}
varimp.info
})
output$esdm.evaluation.info <- renderText({
evaluation.info = 'Models evaluated with'
for (i in seq_len(length(strsplit(result$ESDM@parameters$ensemble.metric, '.', fixed = TRUE)[[1]][-1]))) {
if (i == 1) {
evaluation.info = paste0(evaluation.info, ' ', strsplit(result$ESDM@parameters$ensemble.metric, '.', fixed = TRUE)[[1]][-1][i],' (>',strsplit(result$ESDM@parameters$ensemble.thresh, '|', fixed = TRUE)[[1]][-1][i],')')
} else if (i == length(result$ESDM@parameters$axes.metric) && i != 1) {
evaluation.info = paste0(evaluation.info, ' and ', strsplit(result$ESDM@parameters$ensemble.metric, '.', fixed = TRUE)[[1]][-1][i],' (>',strsplit(result$ESDM@parameters$ensemble.thresh, '|', fixed = TRUE)[[1]][-1][i],')','.')
} else {
evaluation.info = paste0(evaluation.info, ' , ', strsplit(result$ESDM@parameters$ensemble.metric, '.', fixed = TRUE)[[1]][-1][i],' (>',strsplit(result$ESDM@parameters$ensemble.thresh, '|', fixed = TRUE)[[1]][-1][i],')')
}
}
if (result$ESDM@parameters$weight) {evaluation.info = paste(evaluation.info, ', and then weighted with the previous metrics means')}
evaluation.info
})
### Save Menu ###
## Save maps
# select map to save
output$speciesSave.sel <- renderUI({
if(!is.null(data$Stack)){
specieschoices <- reactive({c("all",names(data$Stack@esdms))})
}
if(is.null(data$Stack) & !is.null(data$ESDM)){
specieschoices <-reactive({data$ESDM@name})
}
selectInput('speciesSave', 'Species:', specieschoices())
})
observeEvent(input$speciesSave,{
if(input$speciesSave == "all"){
mapchoices <- list("Diversity map" = "diversity.map", "Endemism map"="endemism.map")}
if(input$speciesSave != "all" & !is.null(input$speciesSave)){
mapchoices <- list("Ensemble map" = "projection")}
if(input$uncert == TRUE){
mapchoices <- c(mapchoices,"Uncertainty map" = "uncertainty")
}
output$mapSave.sel <- renderUI({
selectInput('mapSave','Map type:', mapchoices)
})
})
if(Sys.info()[['sysname']] == 'Linux') {
shinyDirChoose(input, 'savem', session=session, roots=c( wd='.', home = '/home', root = '/'), filetypes=c(''))
} else if (Sys.info()[['sysname']] == 'Windows') {
d = system('wmic logicaldisk get caption', intern = TRUE)
disks = c()
for(i in 2:(length(d)-1)){
disks = c(disks, substr(d[i],1,2))
}
names(disks) = disks
shinyDirChoose(input, 'savem', session=session, roots=c( wd='.', disks), filetypes=c(''))
} else {
shinyDirChoose(input, 'savem', session=session, roots=c( wd='.', home = '/user', root = '/'), filetypes=c(''))
}
observeEvent(input$savemaps, {
path = switch(input$savem$root,
'wd' = working.directory,
'home' = '/home',
'root' = '/',
input$savem$root)
for(i in 2:length(input$savem$path)){
path = paste0(path, '/', input$savem$path[[i]][1])
}
if(grepl("Ensemble",input$speciesSave) & !is.null(data$ESDM)) {
# path <- "/home/lukas/Bilder/output/"
writeRaster(eval(parse(text=paste0("data$ESDM@",input$mapSave))), filename = paste0(path,"/",data$ESDM@name,"_",input$mapSave), format="GTiff",overwrite=TRUE)}
if(grepl("Ensemble",input$speciesSave) & !is.null(data$Stack)) {
#path <- "/home/lukas/Bilder/output"
writeRaster(eval(parse(text=paste0("data$Stack@esdms$",input$speciesSave,"@",input$mapSave))), filename = paste0(path,"/",input$speciesSave,"_",input$mapSave), format="GTiff",overwrite=TRUE)
}
if(input$speciesSave == "all") {
# path <- "/home/lukas/Bilder/output/"
writeRaster(eval(parse(text=paste0("data$Stack@",input$mapSave))), filename = paste0(path,"/",data$Stack@name,"_",input$mapSave), format="GTiff")}
}
)
## Save model page ##
if(Sys.info()[['sysname']] == 'Linux') {
shinyDirChoose(input, 'save', session=session, roots=c( wd='.', home = '/home', root = '/'), filetypes=c(''))
} else if (Sys.info()[['sysname']] == 'Windows') {
d = system('wmic logicaldisk get caption', intern = TRUE)
disks = c()
for(i in 2:(length(d)-1)){
disks = c(disks, substr(d[i],1,2))
}
names(disks) = disks
shinyDirChoose(input, 'save', session=session, roots=c( wd='.', disks), filetypes=c(''))
} else {
shinyDirChoose(input, 'save', session=session, roots=c( wd='.', home = '/user', root = '/'), filetypes=c(''))
}
observeEvent(input$savemodel, {
path = switch(input$save$root,
'wd' = working.directory,
'home' = '/home',
'root' = '/',
input$save$root)
for(i in 2:length(input$save$path)){
path = paste0(path, '/', input$save$path[[i]][1])
}
if(!is.null(data$ESDM) && is.null(data$Stack)) {save.esdm(data$ESDM, name = data$ESDM@name, path, verbose = FALSE, GUI = TRUE)}
if(!is.null(data$Stack)) {save.stack(data$Stack, name = data$Stack@name, path, verbose = FALSE, GUI = TRUE)}
})
### Model forecasting
output$projcheck <- renderText({
if(is.null(data$Env) | (is.null(data$ESDM) & is.null(data$Stack))){"Environmental data and model must both be provided"}
else if(!is.null(data$ESDM)){if(!all(colnames(data$ESDM@data) %in% names(data$Env))){"Provided environmental variables do not match variables used model training. Please check your raster selection."}}
else if(!is.null(data$Stack)){if(!all(colnames(data$Stack@variable.importance) %in% names(data$Env))){"Provided environmental variables do not match variables used for model training. Please check your raster selection."}}
else if(!is.null(data$ESDM)){if(!is.null(data$Stack)){"Several models loaded. Please restart with only one model."}}
})
observeEvent(input$project,{
if(!is.null(data$ESDM) & is.null(data$Stack)){
data$ESDM <- project(data$ESDM,data$Env)
updateTabItems(session, "actions", selected="stackesdm")
}
if(is.null(data$ESDM) & !is.null(data$Stack)){
data$Stack <- project(data$Stack,data$Env)
updateTabItems(session, "actions", selected="stack")
}
})
### Quit Menu ###
## quit page ##
observeEvent(input$quitgui, {
stopApp()
})
}
}
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.