diff --git a/DESCRIPTION b/DESCRIPTION index b413b77..b084fdb 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: SSDM Type: Package Title: Stacked Species Distribution Modelling -Version: 0.1.9040 +Version: 0.2.1 Author: Sylvain Schmitt, Robin Pouteau, Dimitri Justeau, Philippe Birnbaum Maintainer: Sylvain Schmitt URL: https://github.com/sylvainschmitt/SSDM diff --git a/NEWS.Rmd b/NEWS.Rmd index 893aba5..5a403c1 100644 --- a/NEWS.Rmd +++ b/NEWS.Rmd @@ -59,7 +59,7 @@ output: github_document - update in check args # SSDM 0.1.9031 -- `rgdal`issue on travis due to `test_load_vocc` +- `rgdal`issue on travis due to `test_load_occ` # SSDM 0.1.9030 - `rgdal`issue on travis due to `load_var` diff --git a/R/Env.R b/R/Env.R index 18bb7ff..f4d9e20 100644 --- a/R/Env.R +++ b/R/Env.R @@ -12,7 +12,7 @@ #' @references R.J. Hijmans, C.H. & Graham (2006) "The ability of climate #' envelope models to predict the effect of climate change on species #' distributions." \emph{Global Change Biology} 12:2272-2281 -#' \url{http://se-server.ethz.ch/staff/af/Fi159/H/Hi082_S.pdf} +#' \url{http://onlinelibrary.wiley.com/doi/10.1111/j.1365-2486.2006.01256.x/full} #' #' E. Fritsch (2012) "Les sols. Atlas de la Nouvelle-Caledonie (ed. by J. #' Bonvallot, J.-C. Gay and E. Habert)" \emph{IRD-Congres de la diff --git a/R/gui.R b/R/gui.R index 3b6efe1..28f35a5 100644 --- a/R/gui.R +++ b/R/gui.R @@ -6,6 +6,7 @@ #' \code{\link[shiny]{runApp}} for more details). #' @param host char. The IPv4 address that the application should listen on (see #' \code{\link[shiny]{runApp}} for more details). +#' @param working.directory char. Directory in which the application will run. #' #' @return Open a window with a shiny app to use the SSDM package with an #' user-friendly interface. @@ -20,13 +21,18 @@ #' } #' #' @export -gui <- function (port = getOption("shiny.port"), host = getOption("shiny.host", "127.0.0.1")) { +gui <- function (port = getOption("shiny.port"), + host = getOption("shiny.host", "127.0.0.1"), + working.directory = getwd()) { + appDir <- system.file("shiny", "gui", package = "SSDM") if (appDir == "") { - stop("Could not find example directory. Try re-installing `mypackage`.", call. = FALSE) + stop("Could not find shiny directory. Try re-installing `SSDM`.", call. = FALSE) } - assign("working.directory", getwd(), envir = .GlobalEnv) - shiny::runApp(appDir, display.mode = "normal", port = port, host = host) - ls() - rm(working.directory, envir = .GlobalEnv) + + ui <- source(file.path(appDir, 'ui.R')) + serverWD <- source(file.path(appDir, 'server.R')) + shiny::runApp(shinyApp(ui = ui, server = serverWD(working.directory)), + display.mode = "normal", port = port, host = host) + rm(ui, serverWD, envir = .GlobalEnv) } diff --git a/README.Rmd b/README.Rmd index 450ad7c..d701ed5 100644 --- a/README.Rmd +++ b/README.Rmd @@ -4,7 +4,8 @@ output: github_document --- [![Travis-CI Build Status](https://travis-ci.org/sylvainschmitt/SSDM.svg?branch=master)](https://travis-ci.org/sylvainschmitt/SSDM) -[![CRAN](http://www.r-pkg.org/badges/version/SSDM)](http://cran.rstudio.com/package=SSDM) [![Downloads](http://cranlogs.r-pkg.org/badges/SSDM?color=brightgreen)](http://www.r-pkg.org/pkg/SSDM) +[![CRAN](https://www.r-pkg.org/badges/version/SSDM)](https://CRAN.R-project.org/package=SSDM) +[![Downloads](http://cranlogs.r-pkg.org/badges/SSDM?color=brightgreen)](http://www.r-pkg.org/pkg/SSDM) [![Coverage Status](https://img.shields.io/codecov/c/github/sylvainschmitt/SSDM/master.svg)](https://codecov.io/github/sylvainschmitt/SSDM?branch=master) [![Research software impact](http://depsy.org/api/package/cran/SSDM/badge.svg)](http://depsy.org/package/r/SSDM) @@ -41,7 +42,7 @@ install.packages("SSDM") After installing, **SSDM** package, you can launch the graphical user interface by typing gui() in the console.
[**Click to enlarge**](https://raw.githubusercontent.com/sylvainschmitt/SSDM/master/examples/SSDM.gif)
-![Screenshot](examples/SSDM.gif) +![Screenshot](https://raw.githubusercontent.com/sylvainschmitt/SSDM/master/examples/SSDM.gif) # Functionnalities diff --git a/README.md b/README.md index b2ef0a4..2398209 100644 --- a/README.md +++ b/README.md @@ -1,7 +1,7 @@ SSDM: Stacked species distribution modelling ================ -[![Travis-CI Build Status](https://travis-ci.org/sylvainschmitt/SSDM.svg?branch=master)](https://travis-ci.org/sylvainschmitt/SSDM) [![CRAN](http://www.r-pkg.org/badges/version/SSDM)](http://cran.rstudio.com/package=SSDM) [![Downloads](http://cranlogs.r-pkg.org/badges/SSDM?color=brightgreen)](http://www.r-pkg.org/pkg/SSDM) [![Coverage Status](https://img.shields.io/codecov/c/github/sylvainschmitt/SSDM/master.svg)](https://codecov.io/github/sylvainschmitt/SSDM?branch=master) [![Research software impact](http://depsy.org/api/package/cran/SSDM/badge.svg)](http://depsy.org/package/r/SSDM) +[![Travis-CI Build Status](https://travis-ci.org/sylvainschmitt/SSDM.svg?branch=master)](https://travis-ci.org/sylvainschmitt/SSDM) [![CRAN](https://www.r-pkg.org/badges/version/SSDM)](https://CRAN.R-project.org/package=SSDM) [![Downloads](http://cranlogs.r-pkg.org/badges/SSDM?color=brightgreen)](http://www.r-pkg.org/pkg/SSDM) [![Coverage Status](https://img.shields.io/codecov/c/github/sylvainschmitt/SSDM/master.svg)](https://codecov.io/github/sylvainschmitt/SSDM?branch=master) [![Research software impact](http://depsy.org/api/package/cran/SSDM/badge.svg)](http://depsy.org/package/r/SSDM) SSDM is a package to map species richness and endemism based on stacked species distribution models (SSDM). Individual SDMs can be created using a single or multiple algorithms (ensemble SDMs). For each species, an SDM can yield a habitat suitability map, a binary map, a between-algorithm variance map, and can assess variable importance, algorithm accuracy, and between-algorithm correlation. Methods to stack individual SDMs include summing individual probabilities and thresholding then summing. Thresholding can be based on a specific evaluation metric or by drawing repeatedly from a Bernouilli distribution. The SSDM package also provides a user-friendly interface `gui`. @@ -41,7 +41,7 @@ After installing, **SSDM** package, you can launch the graphical user interface
[**Click to enlarge**](https://raw.githubusercontent.com/sylvainschmitt/SSDM/master/examples/SSDM.gif)
-![Screenshot](examples/SSDM.gif) +![Screenshot](https://raw.githubusercontent.com/sylvainschmitt/SSDM/master/examples/SSDM.gif) Functionnalities ================ diff --git a/cran-comment.md b/cran-comment.md index 89625c1..b4d5eae 100644 --- a/cran-comment.md +++ b/cran-comment.md @@ -4,15 +4,21 @@ * win-builder (devel and release) ## R CMD check results -There were no ERRORs, WARNINGs or NOTEs. +There were no ERRORs or WARNINGs. + +There was one NOTE: +Possibly mis-spelled words in DESCRIPTION: + SDM (11:73) + SDMs (10:53, 11:45, 14:56) + SSDM (10:34, 17:23) + Thresholding (15:61) + endemism (9:49) + thresholding (15:34) + +Those are scientific correctly spelled words of species distribution modelling field (SDM). It follows litterature included in pacakge documentation. ## Resubmission This is a resubmission. In this version I have: -* Remove the term package in the first sentence of Description field in DESCRIPTION - -* Actualized Date field in DESCRIPTION to today - -* Import following functions in NAMESPACE : aggregate.data.frame arrows barplot cor glm glm.control heat.colors is.raster legend lsf.str rainbow rbinom read.csv read.csv2 runif sd tail terrain.colors var write.csv - -* Unactivated examples with an elapsed time > 5s +* Fixed CRAN URL canonical form in README +* Fixed reported bug on graphic user interface which was broken (on of the main functionality of the package) without assignment to global environment (following recommendations of Joe Chang https://github.com/rstudio/shiny/issues/237#issuecomment-288244875) diff --git a/inst/shiny/gui/server.R b/inst/shiny/gui/server.R index 34a84e7..de0281a 100644 --- a/inst/shiny/gui/server.R +++ b/inst/shiny/gui/server.R @@ -6,1043 +6,1046 @@ library(shinyFiles) library(raster) library(gplots) -server <- function(input, output, session) { - ### Server data ### - data <- reactiveValues(Env = stack(), Occ = data.frame(), dir = getwd(), ENM = NULL, enms = list(), Stack = NULL) - result <- reactiveValues(ENM = 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(!is.null(data$Stack) || !is.null(data$ENM)) { - if(inherits(data$ENM,'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 = "stackenm", icon = icon("pagelines")), - if(!is.null(data$Stack)){selectInput('enmchoice', 'Species:', data$enms, selectize = TRUE)}, - if(!inherits(data$ENM,'Algorithm.SDM')) {menuItem('Save', tabName = "save", icon = icon("floppy-o"))} - ) - }, - menuItem('Quit', tabName = 'quitpage') - ) - }) +serverWD <- function(working.directory){ + function(input, output, session) { + ### Server data ### + data <- reactiveValues(Env = stack(), Occ = data.frame(), dir = getwd(), ENM = NULL, enms = list(), Stack = NULL) + result <- reactiveValues(ENM = 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(!is.null(data$Stack) || !is.null(data$ENM)) { + if(inherits(data$ENM,'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 = "stackenm", icon = icon("pagelines")), + if(!is.null(data$Stack)){selectInput('enmchoice', 'Species:', data$enms, selectize = TRUE)}, + if(!inherits(data$ENM,'Algorithm.SDM')) {menuItem('Save', tabName = "save", icon = icon("floppy-o"))} + ) + }, + menuItem('Quit', tabName = 'quitpage') + ) + }) - ### Load Menu ### + ### Load Menu ### - ## Load new data page ## + ## 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, + # 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 = '/user', + home = '/home', root = '/'), - filetypes=c('',"grd", "tif", "asc","sdat", "rst", "nc", "tif", "envi", "bil", "img")) - } - observeEvent(input$envfiles,{ - load.var$vars = list() - for(i in seq_len(length(input$envfiles$files))) { - load.var$vars[[i]] = as.character(input$envfiles$files[[i]][length(input$envfiles$files[[i]])]) - } - }) - 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' = '/') + filetypes=c('',"grd", "tif", "asc","sdat", "rst", "nc", "tif", "envi", "bil", "img")) } 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 + 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 { - load.var$norm = FALSE + 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")) } - 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 + observeEvent(input$envfiles,{ + load.var$vars = list() + for(i in seq_len(length(input$envfiles$files))) { + load.var$vars[[i]] = as.character(input$envfiles$files[[i]][length(input$envfiles$files[[i]])]) + } + }) + 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))) { - names(data$Env)[i] = strsplit(load.var$vars[[i]], '.', fixed = TRUE)[[1]][1] + 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)} } - output$layerchoice <- renderUI({ - selectInput('layer', 'Variable', as.list(names(data$Env)), multiple = FALSE, selectize = TRUE) - }) - output$env <- renderPlot({ - 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]] - } - spplot(map, - main = names(data$Env)[i], - xlab = 'Longitude (\u02DA)', - ylab = 'Latitude (\u02DA)', - col.regions = rev(terrain.colors(10000))) + 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 <- renderPlot({ + 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]] + } + spplot(map, + main = names(data$Env)[i], + xlab = 'Longitude (\u02DA)', + ylab = 'Latitude (\u02DA)', + col.regions = rev(terrain.colors(10000))) + } + }) + } + }) - # 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)) + # 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")) } - 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, { - 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.null(input$Occ)) { + observeEvent(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.null(input$Occ)) { + load.occ$columns = names(read.csv2(file)) + }) + observeEvent(input$sep, { + if(!is.null(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.null(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 = '/')) - 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 - } - }) - output$occ <- renderDataTable({if(length(data$Occ) > 0) {data$Occ}}) + 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 + } + }) + 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 !') - ) + ## Load previous model page ## if(Sys.info()[['sysname']] == 'Linux') { - path = switch(input$prevmodel$root, - 'wd' = working.directory, - 'home' = '/home/', - 'root' = '/') + shinyDirChoose(input, 'prevmodel', session=session, + roots = c(wd = working.directory, + home = '/home', + root = '/'), + filetypes=c('')) } else if (Sys.info()[['sysname']] == 'Windows') { - path = switch(input$prevmodel$root, 'wd' = working.directory, input$prevmodel$root) + 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 { - 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_enm(name, path)) - } - if (input$model.type == 'SSDM') { - a = try(withProgress(message = 'Model loading', load_stack(name, path, GUI = TRUE))) + shinyDirChoose(input, 'prevmodel', session=session, + roots = c( wd= working.directory, + home = '/user', + root = '/'), + filetypes=c('')) } - if(inherits(a, 'try-error')){ - output$prevmodelbug <- renderText('Previous model loading failed, please check your inputs and try again') - } else { - output$prevmodelbug <- renderText(' ') + 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') { - data$ENM = a - if(!is.null(data$ENM)){result$ENM = data$ENM} - output$model.preview <- renderPlot({spplot(data$ENM@projection, - main = 'Habitat suitability map', - xlab = 'Longitude (\u02DA)', - ylab = 'Latitude (\u02DA)', - col.regions = rev(terrain.colors(10000)))}) + a = try(load_enm(name, path)) } if (input$model.type == 'SSDM') { - data$Stack = a - for (i in seq_len(length(names(data$Stack@enms)))) {data$enms[[i]] = strsplit(names(data$Stack@enms), '.Ensemble.SDM', fixed = TRUE)[[i]][1]} - output$model.preview <- renderPlot({spplot(data$Stack@diversity.map, - main = data$Stack@name, - xlab = 'Longitude (\u02DA)', - ylab = 'Latitude (\u02DA)', - col.regions = rev(terrain.colors(10000)))}) + 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$ENM = a + if(!is.null(data$ENM)){result$ENM = data$ENM} + output$model.preview <- renderPlot({spplot(data$ENM@projection, + main = 'Habitat suitability map', + xlab = 'Longitude (\u02DA)', + ylab = 'Latitude (\u02DA)', + col.regions = rev(terrain.colors(10000)))}) + } + if (input$model.type == 'SSDM') { + data$Stack = a + for (i in seq_len(length(names(data$Stack@enms)))) {data$enms[[i]] = strsplit(names(data$Stack@enms), '.Ensemble.SDM', fixed = TRUE)[[i]][1]} + output$model.preview <- renderPlot({spplot(data$Stack@diversity.map, + main = data$Stack@name, + xlab = 'Longitude (\u02DA)', + ylab = 'Latitude (\u02DA)', + col.regions = rev(terrain.colors(10000)))}) + } + } + }) - ## 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)]))) + ## 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$algoUI <- renderUI({ + if(input$modellingchoice == 'Algorithm modelling'){ + title = 'Algorithm' + multiple = FALSE + } else { + title = 'Algorithms' + multiple = TRUE } - } - }) - 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') + 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$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','MaximumLikelyhood','PRR.MEM','PRR.pSSDM'), - selected = 'Probability') + }) + 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$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)', - 'MaximumLikelyhood' = '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$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','MaximumLikelyhood','PRR.MEM','PRR.pSSDM'), + selected = 'Probability') } - } - }) - 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)}}}}) + }) + 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)', + 'MaximumLikelyhood' = '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) + ## 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 } - } - }) - 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)') + if(input$cval == 'k-fold'){ + title = 'K fold number' + min = 1 + max = 50 + val = 10 + step = 1 } - } - }) - - ## 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 iteration (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$ENM = NULL - data$Stack = NULL - data$enms = list() - result$ENM = 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(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) + } } - } - 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 + }) + 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)') + } } - data$ENM = 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$ENM@projection, - main = 'Habitat suitability map', - xlab = 'Longitude (\u02DA)', - ylab = 'Latitude (\u02DA)', - col.regions = rev(terrain.colors(10000)))) - result$ENM = data$ENM - } - 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),] + }) + + ## 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 iteration (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$ENM = NULL + data$Stack = NULL + data$enms = list() + result$ENM = 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 { - Occ = data$Occ + 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])) + } } - data$ENM = 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$ENM)){ + 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$ENM = 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$ENM@projection, main = 'Habitat suitability map', xlab = 'Longitude (\u02DA)', ylab = 'Latitude (\u02DA)', col.regions = rev(terrain.colors(10000)))) result$ENM = data$ENM - } 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 = renderPlot(spplot(data$Stack@diversity.map, - main = 'Local species richness', - xlab = 'Longitude (\u02DA)', - ylab = 'Latitude (\u02DA)', - col.regions = rev(terrain.colors(10000)))) - for (i in seq_len(length(names(data$Stack@enms)))) {data$enms[[i]] = strsplit(names(data$Stack@enms), '.Ensemble.SDM', fixed = TRUE)[[i]][1]} + 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$ENM = 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$ENM)){ + output$modelprev = renderPlot(spplot(data$ENM@projection, + main = 'Habitat suitability map', + xlab = 'Longitude (\u02DA)', + ylab = 'Latitude (\u02DA)', + col.regions = rev(terrain.colors(10000)))) + result$ENM = data$ENM + } 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 { - output$modelfailed = renderText('You have less than two remaining ensemble SDMs, maybe you should try lower ensemble threshold(s) ?') + 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 = renderPlot(spplot(data$Stack@diversity.map, + main = 'Local species richness', + xlab = 'Longitude (\u02DA)', + ylab = 'Latitude (\u02DA)', + col.regions = rev(terrain.colors(10000)))) + for (i in seq_len(length(names(data$Stack@enms)))) {data$enms[[i]] = strsplit(names(data$Stack@enms), '.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')) - ranges <- reactiveValues(x = NULL, y = NULL) - observeEvent(input$plot1_dblclick, { - brush <- input$plot1_brush - if (!is.null(brush)) { - if(!is.null(ranges$x)){ref = crop(data$Stack@diversity.map, c(ranges$x, ranges$y))} else {ref = data$Stack@diversity.map} - ranges$x <- c(brush$xmin, brush$xmax) * (extent(ref)[2] - extent(ref)[1]) + extent(ref)[1] - ranges$y <- c(brush$ymin, brush$ymax) * (extent(ref)[4] - extent(ref)[3]) + extent(ref)[3] - } else { - ranges$x <- NULL - ranges$y <- NULL - } - }) - observeEvent(input$unzoom, { - ranges$x <- NULL - ranges$y <- NULL - }) - output$Diversity <- renderPlot({ - if (!is.null(ranges$x)) {diversity = crop(data$Stack@diversity.map, c(ranges$x, ranges$y))} else {diversity = data$Stack@diversity.map} - spplot(diversity, - main = paste('Mean species richness error:', round(data$Stack@evaluation['mean','species.richness.error'], 3)), - xlab = 'Longitude (\u02DA)', - ylab = 'Latitude (\u02DA)', - col.regions = rev(terrain.colors(10000))) - }) - output$endemism <- renderPlot({ - if (!is.null(ranges$x)) {endemism = crop(data$Stack@endemsim.map, c(ranges$x, ranges$y))} else {endemism = data$Stack@endemism.map} - spplot(endemism, - xlab = 'Longitude (\u02DA)', - ylab = 'Latitude (\u02DA)', - col.regions = rev(terrain.colors(10000))) - }) - output$Uncertainity <- renderPlot({ - if (!is.null(ranges$x)) {uncert = crop(data$Stack@uncertainty, c(ranges$x, ranges$y))} else {uncert = data$Stack@uncertainty} - spplot(uncert, - xlab = 'Longitude (\u02DA)', - ylab = 'Latitude (\u02DA)', - col.regions = rev(terrain.colors(10000))) - }) - # 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) - heatmap.2(x = m, Rowv = FALSE, Colv = FALSE, dendrogram = "none", - cellnote = round(m,2), notecol = "black", notecex = 2, - trace = "none", key = FALSE, margins = c(7, 11), na.rm = TRUE, - col = rev(heat.colors(1000))) - }) - # 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@enms), 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],')','.') + ## Stack results ## + output$Stackname <- renderUI(h2(data$Stack@name, align = 'center')) + ranges <- reactiveValues(x = NULL, y = NULL) + observeEvent(input$plot1_dblclick, { + brush <- input$plot1_brush + if (!is.null(brush)) { + if(!is.null(ranges$x)){ref = crop(data$Stack@diversity.map, c(ranges$x, ranges$y))} else {ref = data$Stack@diversity.map} + ranges$x <- c(brush$xmin, brush$xmax) * (extent(ref)[2] - extent(ref)[1]) + extent(ref)[1] + ranges$y <- c(brush$ymin, brush$ymax) * (extent(ref)[4] - extent(ref)[3]) + extent(ref)[3] } 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],')') + ranges$x <- NULL + ranges$y <- NULL } - } - evaluation.info - }) - - ## ENM Stack Result ## - observeEvent(input$enmchoice, { - if(!is.null(data$Stack)){ - # print(data$enms) - # print(input$enmchoice) - if(length(data$enms) > 0){result$ENM = data$Stack@enms[[which(data$enms == input$enmchoice)]]} - } - }) - observeEvent(input$proba_dblclick, { - brush <- input$proba_brush - if (!is.null(brush)) { - if(!is.null(ranges$x)){ref = crop(result$ENM@projection, c(ranges$x, ranges$y))} else {ref = result$ENM@projection} - ranges$x <- c(brush$xmin, brush$xmax) * (extent(ref)[2] - extent(ref)[1]) + extent(ref)[1] - ranges$y <- c(brush$ymin, brush$ymax) * (extent(ref)[4] - extent(ref)[3]) + extent(ref)[3] - } else { + }) + observeEvent(input$unzoom, { ranges$x <- NULL ranges$y <- NULL - } - }) - observeEvent(input$enmunzoom, { - ranges$x <- NULL - ranges$y <- NULL - }) - output$probability <- renderPlot({ - if (!is.null(ranges$x)) {proba = crop(result$ENM@projection, c(ranges$x, ranges$y))} else {proba = result$ENM@projection} - spplot(proba, - main = paste('AUC :',round(result$ENM@evaluation$AUC,3),' Kappa',round(result$ENM@evaluation$Kappa,3)), - xlab = 'Longitude (\u02DA)', - ylab = 'Latitude (\u02DA)', - col.regions = rev(terrain.colors(10000)), - sp.layout=list(SpatialPoints(data.frame(X = result$ENM@data$X[which(result$ENM@data$Presence == 1)], - Y = result$ENM@data$Y[which(result$ENM@data$Presence == 1)])), - pch = 16, cex = 0.7, col = 'black')) - }) - output$niche <- renderPlot({ - niche.map = reclassify(result$ENM@projection, c(-Inf,result$ENM@evaluation$threshold,0, result$ENM@evaluation$threshold,Inf,1)) - if (!is.null(ranges$x)) {niche.map = crop(niche.map, c(ranges$x, ranges$y))} - spplot(niche.map, - main = paste('AUC :',round(result$ENM@evaluation$AUC,3),' Kappa',round(result$ENM@evaluation$Kappa,3)), - col.regions = rev(terrain.colors(10000))) - }) - output$enm.uncertainty <- renderPlot({ - if(!inherits(result$ENM,'Algorithm.SDM')) { - if (!is.null(ranges$x)) {uncert.map = crop(result$ENM@uncertainty, c(ranges$x, ranges$y))} else {uncert.map = result$ENM@uncertainty} - spplot(uncert.map, col.regions = rev(terrain.colors(10000))) - } - }) - # Evaluation - output$enm.evaluation.barplot <- renderPlot({ - evaluation = result$ENM@algorithm.evaluation - if(!(0 %in% dim(evaluation))){ - for (i in seq_len(length(row.names(result$ENM@algorithm.evaluation)))) {row.names(evaluation)[i] = strsplit(as.character(row.names(result$ENM@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$enm.evaluation.table <- renderTable({ - algo.eval = result$ENM@algorithm.evaluation - if(!(0 %in% dim(algo.eval))){ - for (i in seq_len(length(row.names(result$ENM@algorithm.evaluation)))) {row.names(algo.eval)[i] = strsplit(as.character(row.names(result$ENM@algorithm.evaluation)[i]), '.SDM')[[1]][1]} - for (i in seq_len(length(row.names(result$ENM@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$enm.algo.corr.table <- renderTable({ - correlation = result$ENM@algorithm.correlation - for (i in seq_len(length(row.names(result$ENM@algorithm.correlation)))) {row.names(correlation)[i] = strsplit(as.character(row.names(result$ENM@algorithm.correlation)[i]), '.SDM')[[1]][1]} - names(correlation) = row.names(correlation) - if (length(correlation) > 0) { - correlation[upper.tri(correlation, diag = TRUE)] = NA - correlation - } - }) - output$enm.algo.corr.heatmap <- renderPlot({ - correlation = result$ENM@algorithm.correlation - for (i in seq_len(length(row.names(result$ENM@algorithm.correlation)))) {row.names(correlation)[i] = strsplit(as.character(row.names(result$ENM@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) + }) + output$Diversity <- renderPlot({ + if (!is.null(ranges$x)) {diversity = crop(data$Stack@diversity.map, c(ranges$x, ranges$y))} else {diversity = data$Stack@diversity.map} + spplot(diversity, + main = paste('Mean species richness error:', round(data$Stack@evaluation['mean','species.richness.error'], 3)), + xlab = 'Longitude (\u02DA)', + ylab = 'Latitude (\u02DA)', + col.regions = rev(terrain.colors(10000))) + }) + output$endemism <- renderPlot({ + if (!is.null(ranges$x)) {endemism = crop(data$Stack@endemsim.map, c(ranges$x, ranges$y))} else {endemism = data$Stack@endemism.map} + spplot(endemism, + xlab = 'Longitude (\u02DA)', + ylab = 'Latitude (\u02DA)', + col.regions = rev(terrain.colors(10000))) + }) + output$Uncertainity <- renderPlot({ + if (!is.null(ranges$x)) {uncert = crop(data$Stack@uncertainty, c(ranges$x, ranges$y))} else {uncert = data$Stack@uncertainty} + spplot(uncert, + xlab = 'Longitude (\u02DA)', + ylab = 'Latitude (\u02DA)', + col.regions = rev(terrain.colors(10000))) + }) + # 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) heatmap.2(x = m, Rowv = FALSE, Colv = FALSE, dendrogram = "none", - cellnote = round(m,3), notecol = "black", notecex = 2, + cellnote = round(m,2), notecol = "black", notecex = 2, trace = "none", key = FALSE, margins = c(7, 11), na.rm = TRUE, col = rev(heat.colors(1000))) - } - }) - # Algo Eval Corr UI - output$algoevalcorr <- renderUI({ - if(!inherits(result$ENM,'Algorithm.SDM')) { - fluidRow( - tabBox(title = 'Model evaluation', - tabPanel(plotOutput('enm.evaluation.barplot'), - textOutput('enm.evaluation.info'), - title = 'Barplot'), - tabPanel(tableOutput('enm.evaluation.table'), title = 'Table') - ), - - tabBox(title = 'Algorithm correlation', - tabPanel(plotOutput('enm.algo.corr.heatmap'), title = 'Heatmap'), - tabPanel(tableOutput('enm.algo.corr.table'), title = 'Table') - ) - ) - } - }) - # Variable importance - output$enm.varimp.barplot <- renderPlot({ - varimp = as.data.frame(t(result$ENM@variable.importance)) - names(varimp) = 'Axes.evaluation' - barplot(varimp$Axes.evaluation, names.arg = abbreviate(row.names(varimp)), las = 2, ylab = 'Variable relative contribution (%)') - }) - output$enm.varimp.table <- renderTable({result$ENM@variable.importance}) - output$enmvarimplegend <- renderTable({data.frame('Abbreviation' = abbreviate(names(result$ENM@variable.importance)), 'Variable' = names(result$ENM@variable.importance))}) - # Parameters - output$enm.summary <- renderTable({ - if(!inherits(result$ENM,'Algorithm.SDM')) { + }) + # 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('Type of occurrences', 'Number of occurrences', 'Originally selected algorithms', 'Number of repetitions', - 'Pseudo-absence selection method', 'Cross-validation method', 'Cross-validation parameters') + 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(result$ENM@parameters$algorithms, '.', fixed = TRUE)[[1]][-1]))) { - algo.info = paste(algo.info, strsplit(result$ENM@parameters$algorithms, '.', fixed = TRUE)[[1]][-1][i]) - } - if (result$ENM@parameters$PA) {PA = 'default'} - if (result$ENM@parameters$data == "presence-only data set") { - nb.occ = length(as.factor(result$ENM@data$Presence[which(result$ENM@data$Presence==1)])) / sum(result$ENM@algorithm.evaluation$kept.model) - } else { - nb.occ = length(as.factor(result$ENM@data$Presence)) / sum(result$ENM@algorithm.evaluation$kept.model) + 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(result$ENM@parameters$cv == 'LOO') {cv.param = 'None'} - if(result$ENM@parameters$cv == 'holdout') {cv.param = paste('fraction =', - strsplit(result$ENM@parameters$cv.param, '|', fixed = TRUE)[[1]][2], + 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(result$ENM@parameters$cv.param, '|', fixed = TRUE)[[1]][3])} - if(result$ENM@parameters$cv == 'k-fold') {cv.param = paste('k =', - strsplit(result$ENM@parameters$cv.param, '|', fixed = TRUE)[[1]][2], + 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(result$ENM@parameters$cv.param, '|', fixed = TRUE)[[1]][3])} - summary$Summary = c(result$ENM@parameters$data, nb.occ, algo.info, result$ENM@parameters$rep, PA, result$ENM@parameters$cv, cv.param) - if(!is.null(result$ENM@parameters$sp.nb.origin)) { + strsplit(data$Stack@parameters$cv.param, '|', fixed = TRUE)[[1]][3])} + summary$Summary = c(data$Stack@parameters$data, length(data$Stack@enms), 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 = result$ENM@parameters$sp.nb.origin, row.names = 'Original number of species')) + data.frame(Summary = data$Stack@parameters$sp.nb.origin, row.names = 'Original number of species')) } summary - } - else { - data.frame('Not computed') - } - }) - output$enm.binary.info <- renderText({ - metric = switch(result$ENM@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$ENM@evaluation$threshold, digits = 3)) - text - }) - output$enm.varimp.info <- renderText({ - varimp.info = 'Variable relative contribution evaluated with ' - for (i in seq_len(length(result$ENM@parameters$axes.metric))) { - if (i == 1) { - varimp.info = paste(varimp.info, result$ENM@parameters$axes.metric[i]) - } else if (i == length(result$ENM@parameters$axes.metric) && i != 1) { - varimp.info = paste(varimp.info, 'and', result$ENM@parameters$axes.metric[i], '.') + }) + 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(varimp.info, ',', result$ENM@parameters$axes.metric[i]) + varimp.info = paste('Variable relative contribution evaluated with', data$Stack@parameters$axes.metric, '\'s correlation coefficient') } - } - varimp.info - }) - output$enm.evaluation.info <- renderText({ - evaluation.info = 'Models evaluated with' - for (i in seq_len(length(strsplit(result$ENM@parameters$ensemble.metric, '.', fixed = TRUE)[[1]][-1]))) { - if (i == 1) { - evaluation.info = paste0(evaluation.info, ' ', strsplit(result$ENM@parameters$ensemble.metric, '.', fixed = TRUE)[[1]][-1][i],' (>',strsplit(result$ENM@parameters$ensemble.thresh, '|', fixed = TRUE)[[1]][-1][i],')') - } else if (i == length(result$ENM@parameters$axes.metric) && i != 1) { - evaluation.info = paste0(evaluation.info, ' and ', strsplit(result$ENM@parameters$ensemble.metric, '.', fixed = TRUE)[[1]][-1][i],' (>',strsplit(result$ENM@parameters$ensemble.thresh, '|', fixed = TRUE)[[1]][-1][i],')','.') + 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 + }) + + ## ENM Stack Result ## + observeEvent(input$enmchoice, { + if(!is.null(data$Stack)){ + # print(data$enms) + # print(input$enmchoice) + if(length(data$enms) > 0){result$ENM = data$Stack@enms[[which(data$enms == input$enmchoice)]]} + } + }) + observeEvent(input$proba_dblclick, { + brush <- input$proba_brush + if (!is.null(brush)) { + if(!is.null(ranges$x)){ref = crop(result$ENM@projection, c(ranges$x, ranges$y))} else {ref = result$ENM@projection} + ranges$x <- c(brush$xmin, brush$xmax) * (extent(ref)[2] - extent(ref)[1]) + extent(ref)[1] + ranges$y <- c(brush$ymin, brush$ymax) * (extent(ref)[4] - extent(ref)[3]) + extent(ref)[3] } else { - evaluation.info = paste0(evaluation.info, ' , ', strsplit(result$ENM@parameters$ensemble.metric, '.', fixed = TRUE)[[1]][-1][i],' (>',strsplit(result$ENM@parameters$ensemble.thresh, '|', fixed = TRUE)[[1]][-1][i],')') + ranges$x <- NULL + ranges$y <- NULL } - } - if (result$ENM@parameters$weight) {evaluation.info = paste(evaluation.info, ', and then weighted with the previous metrics means')} - evaluation.info - }) + }) + observeEvent(input$enmunzoom, { + ranges$x <- NULL + ranges$y <- NULL + }) + output$probability <- renderPlot({ + if (!is.null(ranges$x)) {proba = crop(result$ENM@projection, c(ranges$x, ranges$y))} else {proba = result$ENM@projection} + spplot(proba, + main = paste('AUC :',round(result$ENM@evaluation$AUC,3),' Kappa',round(result$ENM@evaluation$Kappa,3)), + xlab = 'Longitude (\u02DA)', + ylab = 'Latitude (\u02DA)', + col.regions = rev(terrain.colors(10000)), + sp.layout=list(SpatialPoints(data.frame(X = result$ENM@data$X[which(result$ENM@data$Presence == 1)], + Y = result$ENM@data$Y[which(result$ENM@data$Presence == 1)])), + pch = 16, cex = 0.7, col = 'black')) + }) + output$niche <- renderPlot({ + niche.map = reclassify(result$ENM@projection, c(-Inf,result$ENM@evaluation$threshold,0, result$ENM@evaluation$threshold,Inf,1)) + if (!is.null(ranges$x)) {niche.map = crop(niche.map, c(ranges$x, ranges$y))} + spplot(niche.map, + main = paste('AUC :',round(result$ENM@evaluation$AUC,3),' Kappa',round(result$ENM@evaluation$Kappa,3)), + col.regions = rev(terrain.colors(10000))) + }) + output$enm.uncertainty <- renderPlot({ + if(!inherits(result$ENM,'Algorithm.SDM')) { + if (!is.null(ranges$x)) {uncert.map = crop(result$ENM@uncertainty, c(ranges$x, ranges$y))} else {uncert.map = result$ENM@uncertainty} + spplot(uncert.map, col.regions = rev(terrain.colors(10000))) + } + }) + # Evaluation + output$enm.evaluation.barplot <- renderPlot({ + evaluation = result$ENM@algorithm.evaluation + if(!(0 %in% dim(evaluation))){ + for (i in seq_len(length(row.names(result$ENM@algorithm.evaluation)))) {row.names(evaluation)[i] = strsplit(as.character(row.names(result$ENM@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$enm.evaluation.table <- renderTable({ + algo.eval = result$ENM@algorithm.evaluation + if(!(0 %in% dim(algo.eval))){ + for (i in seq_len(length(row.names(result$ENM@algorithm.evaluation)))) {row.names(algo.eval)[i] = strsplit(as.character(row.names(result$ENM@algorithm.evaluation)[i]), '.SDM')[[1]][1]} + for (i in seq_len(length(row.names(result$ENM@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)] + } + }) - ### Save Menu ### + # Algorithms correlation + output$enm.algo.corr.table <- renderTable({ + correlation = result$ENM@algorithm.correlation + for (i in seq_len(length(row.names(result$ENM@algorithm.correlation)))) {row.names(correlation)[i] = strsplit(as.character(row.names(result$ENM@algorithm.correlation)[i]), '.SDM')[[1]][1]} + names(correlation) = row.names(correlation) + if (length(correlation) > 0) { + correlation[upper.tri(correlation, diag = TRUE)] = NA + correlation + } + }) + output$enm.algo.corr.heatmap <- renderPlot({ + correlation = result$ENM@algorithm.correlation + for (i in seq_len(length(row.names(result$ENM@algorithm.correlation)))) {row.names(correlation)[i] = strsplit(as.character(row.names(result$ENM@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) + heatmap.2(x = m, Rowv = FALSE, Colv = FALSE, dendrogram = "none", + cellnote = round(m,3), notecol = "black", notecex = 2, + trace = "none", key = FALSE, margins = c(7, 11), na.rm = TRUE, + col = rev(heat.colors(1000))) + } + }) + # Algo Eval Corr UI + output$algoevalcorr <- renderUI({ + if(!inherits(result$ENM,'Algorithm.SDM')) { + fluidRow( + tabBox(title = 'Model evaluation', + tabPanel(plotOutput('enm.evaluation.barplot'), + textOutput('enm.evaluation.info'), + title = 'Barplot'), + tabPanel(tableOutput('enm.evaluation.table'), title = 'Table') + ), - ## 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]) + tabBox(title = 'Algorithm correlation', + tabPanel(plotOutput('enm.algo.corr.heatmap'), title = 'Heatmap'), + tabPanel(tableOutput('enm.algo.corr.table'), title = 'Table') + ) + ) + } + }) + # Variable importance + output$enm.varimp.barplot <- renderPlot({ + varimp = as.data.frame(t(result$ENM@variable.importance)) + names(varimp) = 'Axes.evaluation' + barplot(varimp$Axes.evaluation, names.arg = abbreviate(row.names(varimp)), las = 2, ylab = 'Variable relative contribution (%)') + }) + output$enm.varimp.table <- renderTable({result$ENM@variable.importance}) + output$enmvarimplegend <- renderTable({data.frame('Abbreviation' = abbreviate(names(result$ENM@variable.importance)), 'Variable' = names(result$ENM@variable.importance))}) + # Parameters + output$enm.summary <- renderTable({ + if(!inherits(result$ENM,'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$ENM@parameters$algorithms, '.', fixed = TRUE)[[1]][-1]))) { + algo.info = paste(algo.info, strsplit(result$ENM@parameters$algorithms, '.', fixed = TRUE)[[1]][-1][i]) + } + if (result$ENM@parameters$PA) {PA = 'default'} + if (result$ENM@parameters$data == "presence-only data set") { + nb.occ = length(as.factor(result$ENM@data$Presence[which(result$ENM@data$Presence==1)])) / sum(result$ENM@algorithm.evaluation$kept.model) + } else { + nb.occ = length(as.factor(result$ENM@data$Presence)) / sum(result$ENM@algorithm.evaluation$kept.model) + } + if(result$ENM@parameters$cv == 'LOO') {cv.param = 'None'} + if(result$ENM@parameters$cv == 'holdout') {cv.param = paste('fraction =', + strsplit(result$ENM@parameters$cv.param, '|', fixed = TRUE)[[1]][2], + 'rep =', + strsplit(result$ENM@parameters$cv.param, '|', fixed = TRUE)[[1]][3])} + if(result$ENM@parameters$cv == 'k-fold') {cv.param = paste('k =', + strsplit(result$ENM@parameters$cv.param, '|', fixed = TRUE)[[1]][2], + 'rep =', + strsplit(result$ENM@parameters$cv.param, '|', fixed = TRUE)[[1]][3])} + summary$Summary = c(result$ENM@parameters$data, nb.occ, algo.info, result$ENM@parameters$rep, PA, result$ENM@parameters$cv, cv.param) + if(!is.null(result$ENM@parameters$sp.nb.origin)) { + summary = rbind(summary, + data.frame(Summary = result$ENM@parameters$sp.nb.origin, row.names = 'Original number of species')) + } + summary + } + else { + data.frame('Not computed') + } + }) + output$enm.binary.info <- renderText({ + metric = switch(result$ENM@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$ENM@evaluation$threshold, digits = 3)) + text + }) + output$enm.varimp.info <- renderText({ + varimp.info = 'Variable relative contribution evaluated with ' + for (i in seq_len(length(result$ENM@parameters$axes.metric))) { + if (i == 1) { + varimp.info = paste(varimp.info, result$ENM@parameters$axes.metric[i]) + } else if (i == length(result$ENM@parameters$axes.metric) && i != 1) { + varimp.info = paste(varimp.info, 'and', result$ENM@parameters$axes.metric[i], '.') + } else { + varimp.info = paste(varimp.info, ',', result$ENM@parameters$axes.metric[i]) + } + } + varimp.info + }) + output$enm.evaluation.info <- renderText({ + evaluation.info = 'Models evaluated with' + for (i in seq_len(length(strsplit(result$ENM@parameters$ensemble.metric, '.', fixed = TRUE)[[1]][-1]))) { + if (i == 1) { + evaluation.info = paste0(evaluation.info, ' ', strsplit(result$ENM@parameters$ensemble.metric, '.', fixed = TRUE)[[1]][-1][i],' (>',strsplit(result$ENM@parameters$ensemble.thresh, '|', fixed = TRUE)[[1]][-1][i],')') + } else if (i == length(result$ENM@parameters$axes.metric) && i != 1) { + evaluation.info = paste0(evaluation.info, ' and ', strsplit(result$ENM@parameters$ensemble.metric, '.', fixed = TRUE)[[1]][-1][i],' (>',strsplit(result$ENM@parameters$ensemble.thresh, '|', fixed = TRUE)[[1]][-1][i],')','.') + } else { + evaluation.info = paste0(evaluation.info, ' , ', strsplit(result$ENM@parameters$ensemble.metric, '.', fixed = TRUE)[[1]][-1][i],' (>',strsplit(result$ENM@parameters$ensemble.thresh, '|', fixed = TRUE)[[1]][-1][i],')') + } + } + if (result$ENM@parameters$weight) {evaluation.info = paste(evaluation.info, ', and then weighted with the previous metrics means')} + evaluation.info + }) + + ### Save Menu ### + + ## 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('')) } - if(!is.null(data$ENM) && is.null(data$Stack)) {save.enm(data$ENM, name = data$ENM@name, path, verbose = FALSE, GUI = TRUE)} - if(!is.null(data$Stack)) {save.stack(data$Stack, name = data$Stack@name, path, verbose = FALSE, GUI = TRUE)} - }) + 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$ENM) && is.null(data$Stack)) {save.enm(data$ENM, name = data$ENM@name, path, verbose = FALSE, GUI = TRUE)} + if(!is.null(data$Stack)) {save.stack(data$Stack, name = data$Stack@name, path, verbose = FALSE, GUI = TRUE)} + }) - ### Quit Menu ### + ### Quit Menu ### - ## quitl page ## - observeEvent(input$quitgui, { - stopApp() - }) + ## quitl page ## + observeEvent(input$quitgui, { + stopApp() + }) + } } diff --git a/man/Env.Rd b/man/Env.Rd index 3c30511..16e3e62 100644 --- a/man/Env.Rd +++ b/man/Env.Rd @@ -20,7 +20,7 @@ the IRD Atlas of New Caledonia (2012) (see reference below). R.J. Hijmans, C.H. & Graham (2006) "The ability of climate envelope models to predict the effect of climate change on species distributions." \emph{Global Change Biology} 12:2272-2281 - \url{http://se-server.ethz.ch/staff/af/Fi159/H/Hi082_S.pdf} + \url{http://onlinelibrary.wiley.com/doi/10.1111/j.1365-2486.2006.01256.x/full} E. Fritsch (2012) "Les sols. Atlas de la Nouvelle-Caledonie (ed. by J. Bonvallot, J.-C. Gay and E. Habert)" \emph{IRD-Congres de la diff --git a/man/gui.Rd b/man/gui.Rd index 63aee71..08b1bdd 100644 --- a/man/gui.Rd +++ b/man/gui.Rd @@ -5,7 +5,7 @@ \title{SSDM package Graphic User Interface} \usage{ gui(port = getOption("shiny.port"), host = getOption("shiny.host", - "127.0.0.1")) + "127.0.0.1"), working.directory = getwd()) } \arguments{ \item{port}{char. The TCP port that the application should listen on (see @@ -13,6 +13,8 @@ gui(port = getOption("shiny.port"), host = getOption("shiny.host", \item{host}{char. The IPv4 address that the application should listen on (see \code{\link[shiny]{runApp}} for more details).} + +\item{working.directory}{char. Directory in which the application will run.} } \value{ Open a window with a shiny app to use the SSDM package with an