From 1a01e564eb3f1cdfdd63afd4ce9ea6075a7e2a61 Mon Sep 17 00:00:00 2001 From: Bethany Johnson Date: Thu, 12 Dec 2024 17:31:57 -0500 Subject: [PATCH 1/3] v2024.12.12: - fixed payload to accept user SDMs - fixed Dani's bio --- DESCRIPTION | 4 ++-- README.md | 2 +- inst/shiny/Rmd/text_about.Rmd | 2 +- inst/shiny/Rmd/text_intro_tab.Rmd | 2 +- inst/shiny/Rmd/userReport_intro.Rmd | 2 +- 5 files changed, 6 insertions(+), 6 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 4ca1f159..e9b475cf 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: wallace -Version: 2024.11.18 -Date: 2024-11-18 +Version: 2024.12.12 +Date: 2024-12-12 Title: A Modular Platform for Reproducible Modeling of Species Niches and Distributions Description: The 'shiny' application Wallace is a modular platform for diff --git a/README.md b/README.md index 053ac334..ddd0e915 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ [![R-CMD-check](https://github.com/wallaceEcoMod/wallace/workflows/R-CMD-check/badge.svg)](https://github.com/wallaceEcoMod/wallace/actions) [![License: GPL v3](https://img.shields.io/badge/License-GPL%20v3-blue.svg)](https://www.gnu.org/licenses/gpl-3.0) [![CRAN version](http://www.r-pkg.org/badges/version/wallace)](https://CRAN.R-project.org/package=wallace) [![downloads](https://cranlogs.r-pkg.org:443/badges/grand-total/wallace?color=orange)](https://cranlogs.r-pkg.org:443/badges/grand-total/wallace?color=orange) -# Wallace (v2024.11.18) +# Wallace (v2024.12.12) *Wallace* is a modular platform for reproducible modeling of species niches and distributions, written in R. The application guides users through a complete analysis, from the acquisition of data to visualizing model predictions on an interactive map, thus bundling complex workflows into a single, streamlined interface. Developmental versions (such as this branch) can be downloaded from Github with the following R code. diff --git a/inst/shiny/Rmd/text_about.Rmd b/inst/shiny/Rmd/text_about.Rmd index bc5a8404..2a049273 100644 --- a/inst/shiny/Rmd/text_about.Rmd +++ b/inst/shiny/Rmd/text_about.Rmd @@ -6,7 +6,7 @@ output: html_document ### **What is *Wallace*?** logo -Welcome to *Wallace*, a flexible application for reproducible ecological modeling, built for community expansion. The current version of *Wallace* (v2024.09.18) steps the user through a full niche/distribution modeling analysis, from data acquisition to visualizing results. +Welcome to *Wallace*, a flexible application for reproducible ecological modeling, built for community expansion. The current version of *Wallace* (v2024.12.12) steps the user through a full niche/distribution modeling analysis, from data acquisition to visualizing results. The application is written in `R` with the web app development package `shiny`. Please find the stable version of *Wallace* on CRAN, and the development version on Github. We also maintain a *Wallace* website that has some basic info, links, and will be updated with tutorial materials in the near future. diff --git a/inst/shiny/Rmd/text_intro_tab.Rmd b/inst/shiny/Rmd/text_intro_tab.Rmd index b00cb7e5..6ea768b4 100644 --- a/inst/shiny/Rmd/text_intro_tab.Rmd +++ b/inst/shiny/Rmd/text_intro_tab.Rmd @@ -5,7 +5,7 @@ output: html_document #### WORKFLOW -*Wallace* (v2024.11.18) currently includes ten components, or steps of a possible workflow. Each component includes two or more modules, which are possible analyses for that step. +*Wallace* (v2024.12.12) currently includes thirteen components, or steps of a possible workflow. Each component includes two or more modules, which are possible analyses for that step. **Components:** diff --git a/inst/shiny/Rmd/userReport_intro.Rmd b/inst/shiny/Rmd/userReport_intro.Rmd index 8beb9ff4..0ff3d656 100644 --- a/inst/shiny/Rmd/userReport_intro.Rmd +++ b/inst/shiny/Rmd/userReport_intro.Rmd @@ -10,7 +10,7 @@ knit_engines$set(asis = function(options) { knitr::opts_chunk$set(message = FALSE, warning = FALSE, eval = FALSE) ``` -Please find below the R code history from your *Wallace* v2024.11.18 session. +Please find below the R code history from your *Wallace* v2024.12.12 session. You can reproduce your session results by running this R Markdown file in RStudio. From 26948fae6da5d007395926c408b4ed0d9d043935 Mon Sep 17 00:00:00 2001 From: Bethany Johnson Date: Thu, 12 Dec 2024 17:32:12 -0500 Subject: [PATCH 2/3] fixed dani's photo --- inst/shiny/Rmd/text_team.Rmd | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/inst/shiny/Rmd/text_team.Rmd b/inst/shiny/Rmd/text_team.Rmd index fd06e36e..ba4b11ce 100644 --- a/inst/shiny/Rmd/text_team.Rmd +++ b/inst/shiny/Rmd/text_team.Rmd @@ -28,13 +28,13 @@ output: html_document Andrea Paz (developer) received her PhD at CUNY Graduate Center and City College of New York, after which she was a Postdoctoral Researcher at the Crowther Lab in ETH Zürich. She is now an Assistant Professor at the Biological Sciences Department, University of Montréal.
-dani - beth Beth E. Gerstner (developer, Wallace Fellow) received her PhD from Michigan State University, is a NASA FINESST Award winner, and a Wallace fellow. She currently works for Map of Life at the Center for Biodiversity and Global Change at Yale University.
+dani + Daniel López Lozano (developer) is a Biodiversity Informatics Specialist at the American Museum of Natural History's Center for Biodiversity & Conservation.
From 4a3aadd7b6d22d59592478caa4c54dd3c12bd820 Mon Sep 17 00:00:00 2001 From: Bethany Johnson Date: Thu, 12 Dec 2024 17:32:30 -0500 Subject: [PATCH 3/3] updates to payload --- inst/shiny/custom_modules/rep_biomodelos.R | 171 +++++++++++++++++---- 1 file changed, 141 insertions(+), 30 deletions(-) diff --git a/inst/shiny/custom_modules/rep_biomodelos.R b/inst/shiny/custom_modules/rep_biomodelos.R index 544b299b..91fbf412 100644 --- a/inst/shiny/custom_modules/rep_biomodelos.R +++ b/inst/shiny/custom_modules/rep_biomodelos.R @@ -60,34 +60,55 @@ rep_biomodelos_module_server <- function(input, output, session, common) { }) observeEvent(input$pushBiomod, { - if (is.null(spp[[curSp()]]$visualization$mapPred)) { + if (is.null(spp[[curSp()]]$occs)) { #add warning shinyalert::shinyalert( - "You need a map prediction built on Wallace in order to push payload to BioModelos. ", + "You need occurrence data loaded in order to push payload to BioModelos. ", type = "error") return() } else { if (spp[[bioSp()]]$rmm$data$occurrence$sources != "Biomodelos") { shinyalert::shinyalert( - "You must submit a model built with occurrences from BioModelos. ", + "Your model may not be built with occurrences from BioModelos. ", type = "error") - return() - } - if (is.null(spp[[bioSp()]]$biomodelos$prediction)) { - shinyalert::shinyalert( - "You need a map prediction built on Wallace before pushing to BioModelos. ", - type = "error") - return() + #return() } + # if (is.null(spp[[bioSp()]]$biomodelos$prediction)) { + # shinyalert::shinyalert( + # "You need a map prediction built on Wallace before pushing to BioModelos. ", + # type = "error") + # # return() + # } URL <- 'https://api-biomodelos.humboldt.org.co/v2/models' - + ### Create Manifest manifest <- list( - edited_occurrences = paste0(bioSp(), '_occs.csv'), - raster_model_prediction = paste0(bioSp(), '_pred.tif'), - raster_model_threshold = paste0(bioSp(), '_thr.csv'), + edited_occurrences = + if (is.null(spp[[bioSp()]]$occData$occsOrig)) { + "No occurrences uploaded. " + } else { + paste0(bioSp(), '_occs.csv') + }, + raster_model_prediction = + if (is.null(spp[[bioSp()]]$biomodelos$prediction)) { + "No prediction. " + } else { + paste0(bioSp(), '_pred.tif') + }, + raster_model_threshold = + if (is.null(spp[[bioSp()]]$biomodelos$thrs)) { + "No threshold values. " + } else { + paste0(bioSp(), '_thr.csv') + }, + raster_user_prediction = + if (is.null(spp[[bioSp()]]$biomodelos$mask$userSDM)) { + "No user-specified SDM. " + } else { + paste0(bioSp(), '_userSDM.tif') + }, raster_model_modified_expert = if (is.null(spp[[bioSp()]]$biomodelos$predExpert)) { "No model prediction modified by expert." @@ -95,37 +116,72 @@ rep_biomodelos_module_server <- function(input, output, session, common) { paste0(bioSp(), '_pred_expert.tif') }, shape_file_expert = - if (is.null(spp[[bioSp()]]$mask$expertPoly)) { + if (is.null(spp[[bioSp()]]$mask$removePoly)) { "No model prediction modified by expert." } else { - paste0(bioSp(), '_expertPolygonsShp.zip') + paste0(bioSp(), '_expertPolygonShp.zip') }, - shape_file_extent = paste0(bioSp(), '_projectionExtentShp.zip'), - biomodelos_metadata = paste0(bioSp(), '_metadata.csv'), - model_metadata = paste0(bioSp(), '_rmms.csv'), - wallace_session = paste0(bioSp(), '_session.Rmd') + shape_file_extent = + if (is.null(spp[[bioSp()]]$procEnvs$bgExt)) { + "No background extent. " + } else { + paste0(bioSp(), '_bgExtentShp.zip') + }, + userSDM_extent = + if (is.null(spp[[bioSp()]]$biomodelos$mask$userPolyExt)) { + "No userSDM background extent. " + } else { + paste0(bioSp(), '_userSDM_ExtentShp.zip') + }, + biomodelos_metadata = + paste0(bioSp(), '_metadata.csv'), + model_metadata = + paste0(bioSp(), '_rmms.csv'), + wallace_session = + paste0(bioSp(), '_session.Rmd') + # to add something else to the manifest + # new_thing = + # if (is.null(spp[[bioSp()]]$biomodelos$check$here$to$see$if$null)) { + # "Paste statement saying it is null. " + # } else { + # paste0(bioSp(), '_whatever.filetype') + # }, ) - ### Create files + ### Create Files tmpdir <- tempdir() # Create occs # add req occs + if (!is.null(spp[[bioSp()]]$occData$occsOrig)) { tmpOccs <- file.path(tmpdir, paste0(bioSp(), '_occs.csv')) occsBio <- spp[[bioSp()]]$occData$occsOrig usedOccs <- occsBio$occID %in% spp[[bioSp()]]$occs$occID occsBio <- cbind(occsBio, use = usedOccs) write.csv(occsBio, tmpOccs, row.names = FALSE) + } # Create mapPrediction # add req pred + if (!is.null(spp[[bioSp()]]$biomodelos$prediction)) { tmpPred <- file.path(tmpdir, paste0(bioSp(), '_pred.tif')) raster::writeRaster(spp[[bioSp()]]$biomodelos$prediction, tmpPred, overwrite = TRUE) + } # Create thr # add req occs + if (!is.null(spp[[bioSp()]]$biomodelos$thrs)) { tmpThrs <- file.path(tmpdir, paste0(bioSp(), '_thr.csv')) write.csv(spp[[bioSp()]]$biomodelos$thrs, tmpThrs, row.names = TRUE) + } + + # Create userSDM prediction + # add req pred + if (!is.null(spp[[bioSp()]]$biomodelos$mask$userSDM)) { + tmpUserSDM <- file.path(tmpdir, paste0(bioSp(), '_userSDM.tif')) + raster::writeRaster(spp[[bioSp()]]$biomodelos$mask$userSDM, tmpUserSDM, + overwrite = TRUE) + } # Create raster model modified by expert if (!is.null(spp[[bioSp()]]$biomodelos$predExpert)) { @@ -135,25 +191,26 @@ rep_biomodelos_module_server <- function(input, output, session, common) { } # Create shapefile of expert polygons - if (!is.null(spp[[bioSp()]]$mask$expertPoly)) { - tmpExpPoly <- file.path(tmpdir, paste0(bioSp(), '_expertPolygonsShp.zip')) + if (!is.null(spp[[bioSp()]]$mask$removePoly)) { + tmpExpPoly <- file.path(tmpdir, paste0(bioSp(), '_expertPolygonShp.zip')) expertPolys <- do.call("rbind", c(args = lapply(seq_along(spp[[bioSp()]]$mask$expertPoly), function(i){spp[[bioSp()]]$mask$expertPoly[i][[1]]}), makeUniqueIDs = TRUE)) sf::st_write(obj = sf::st_as_sf(expertPolys), dsn = tmpdir, - layer = paste0(bioSp(), '_expertPolygonsShp'), + layer = paste0(bioSp(), '_expertPolygonShp'), driver = "ESRI Shapefile", append = FALSE) extsExpPoly <- c('dbf', 'shp', 'shx') - fsExpPoly <- file.path(tmpdir, paste0(bioSp(), '_expertPolygonsShp.', extsExpPoly)) + fsExpPoly <- file.path(tmpdir, paste0(bioSp(), '_expertPolygonShp.', extsExpPoly)) zip::zipr(zipfile = tmpExpPoly , files = fsExpPoly) } # Create extent shapefile # add req ext - tmpExt <- file.path(tmpdir, paste0(bioSp(), '_projectionExtentShp.zip')) + if (!is.null(spp[[bioSp()]]$procEnvs$bgExt)) { + tmpExt <- file.path(tmpdir, paste0(bioSp(), '_bgExtentShp.zip')) sf::st_write(obj = sf::st_as_sf(spp[[bioSp()]]$procEnvs$bgExt), dsn = tmpdir, layer = paste0(bioSp(), '_bgShp'), @@ -162,8 +219,24 @@ rep_biomodelos_module_server <- function(input, output, session, common) { exts <- c('dbf', 'shp', 'shx') fsExt <- file.path(tmpdir, paste0(bioSp(), '_bgShp.', exts)) zip::zipr(zipfile = tmpExt, files = fsExt) + } + + # Create userSDM extent shapefile + # add req ext + if (!is.null(spp[[bioSp()]]$biomodelos$mask$userPolyExt)) { + tmpUserSDMExt <- file.path(tmpdir, paste0(bioSp(), '_userSDM_ExtentShp.zip')) + sf::st_write(obj = sf::st_as_sf(spp[[bioSp()]]$biomodelos$mask$userPolyExt), + dsn = tmpdir, + layer = paste0(bioSp(), '_userSDM_bgShp'), + driver = "ESRI Shapefile", + append = FALSE) + exts <- c('dbf', 'shp', 'shx') + fsExt <- file.path(tmpdir, paste0(bioSp(), '_userSDM_bgShp.', exts)) + zip::zipr(zipfile = tmpUserSDMExt, files = fsExt) + } # Create Metadata + if (!is.null(spp[[bioSp()]]$evalOut)) { evalTbl <- spp[[bioSp()]]$evalOut@results if (grepl("Maxent", spp[[bioSp()]]$biomodelos$modelingMethod, fixed = TRUE)) { evalTbl <- evalTbl[evalTbl$tune.args == spp[[bioSp()]]$rmd$vis_curModel, ] @@ -229,6 +302,7 @@ rep_biomodelos_module_server <- function(input, output, session, common) { '.zip')) names(bioMet) <- c("name", "value") write.csv(bioMet, tmpBioMeta, row.names = FALSE) + } # add req metadata tmpRMM <- file.path(tmpdir, paste0(bioSp(), '_rmms.csv')) @@ -299,19 +373,53 @@ rep_biomodelos_module_server <- function(input, output, session, common) { combined_rmd <- gsub('``` r', '```{r}', combined_md) writeLines(combined_rmd, tmpRMD, useBytes = TRUE) - # Create ZIP file - tmpZIP <- file.path(tmpdir, paste0(spp[[bioSp()]]$rmm$code$wallace$biomodelosTaxID, '.zip')) - filesZIP <- c(tmpOccs, tmpBioMeta, tmpPred, tmpThrs, tmpExt, tmpRMM, tmpRMD) + # create file for new item added to manifest + # if (!is.null(spp[[bioSp()]]$biomodelos$check$here$to$see$if$null)) { + # name_of_created_file <- file.path(tmpdir, paste0(bioSp(), '_whatever.filetype')) + # write_function(spp[[bioSp()]]$biomodelos$NEWTHING, name_of_created_file, + # overwrite = TRUE) + # } + + + ### Create ZIP File + tmpZIP <- file.path(tmpdir, paste0(spp[[bioSp()]], '.zip')) + filesZIP <- c(tmpRMM, tmpRMD) + if (!is.null(spp[[bioSp()]]$occData$occsOrig)) { + filesZIP <- c(filesZIP, tmpOccs) + } + if (!is.null(spp[[bioSp()]]$evalOut)) { + filesZIP <- c(filesZIP, tmpBioMeta) + } + if (!is.null(spp[[bioSp()]]$biomodelos$prediction)) { + filesZIP <- c(filesZIP, tmpPred) + } + if (!is.null(spp[[bioSp()]]$biomodelos$thrs)) { + filesZIP <- c(filesZIP, tmpThrs) + } + if (!is.null(spp[[bioSp()]]$procEnvs$bgExt)) { + filesZIP <- c(filesZIP, tmpExt) + } + if (!is.null(spp[[bioSp()]]$biomodelos$mask$userSDM)) { + filesZIP <- c(filesZIP, tmpUserSDM) + } + if (!is.null(spp[[bioSp()]]$biomodelos$mask$userPolyExt)) { + filesZIP <- c(filesZIP, tmpUserSDMExt) + } if (!is.null(spp[[bioSp()]]$biomodelos$predExpert)) { filesZIP <- c(filesZIP, tmpPredExp) } - if (!is.null(spp[[bioSp()]]$mask$expertPolyt)) { + if (!is.null(spp[[bioSp()]]$mask$expertPoly)) { filesZIP <- c(filesZIP, tmpExpPoly) } + # to add something to the zip + #if (!is.null(spp[[bioSp()]]$check$if$null)) { + # filesZIP <- c(filesZIP, name_of_created_file) + # } zip::zipr(zipfile = tmpZIP, files = filesZIP) + ### Create Payload PAYLOAD <- list( taxID = spp[[bioSp()]]$rmm$code$wallace$biomodelosTaxID, biomodelos_user = input$userBio, @@ -321,10 +429,13 @@ rep_biomodelos_module_server <- function(input, output, session, common) { model = httr::upload_file(tmpZIP, type = "application/zip") ) + + response <- httr::content(httr::POST(URL, body = PAYLOAD, encode = "multipart", httr::add_headers(host = 'api-biomodelos.humboldt.org.co', authorization = paste0('apiKey ', input$keyPost))), as = 'parsed') + if (is.null(response)) { shinyalert::shinyalert( "Pushed to BioModelos (**)",