knitr::opts_chunk$set(echo=T, message=F, warning=F) library(prioritizr) # devtools::load_all("~/github/prioritizr") #library(bbnj) # devtools::load_all() # setwd(here()); devtools::install_local(force=T) # devtools::install_github("ecoquants/bbnj") library(raster) library(sf) library(dplyr) library(readr) library(stringr) library(glue) library(here) library(fs) library(knitr) library(formattable) area = raster::area select = dplyr::select #message("library done") if (interactive()){ wd <- file.path(here::here(), "inst/app/www/scenarios/") setwd(wd) # getwd() if (!exists("rmd")){ #rmd <- file.path(getwd(), "s00a.bio.30pct.gl.mol50km.Rmd") rmd <- file.choose() } } else { rmd <- knitr::current_input(dir = T) } pfx <- rmd %>% path_ext_remove() tif <- glue("{pfx}_sol.tif")
# variables ---- rel_target <- 1 prjres <- "_mol50km" # prjres in: View(projections_tbl) redo <- T # problem & solution ---- P <- projections_tbl %>% filter(prjres == !!prjres) if (!file.exists(tif) | redo){ # planning unit: ---- r_pu_id <- get_d_prjres("r_pu_id", prjres) # plot(r_pu_id) r_pu <- setValues(r_pu_id, 1) %>% mask(r_pu_id) # plot(r_pu) # biodiversity: now, not 2100 ---- # devtools::load_all() #s_bio_gmbi <- get_d_prjres("s_bio_gmbi", prjres) #groups01: 1st taxonomic grouping # s_bio_gmbi <- get_gmbi_grpsmdl_prjres("groups01", "_mol50km") # lyrs_bio_now <- names(s_bio_gmbi) %>% # setdiff(str_subset(names(s_bio_gmbi), "rli")) # s_bio_now <- subset(s_bio_gmbi, lyrs_bio_now) #add red list sum for all species as separate layer # rls_all <- get_d_prjres("s_bio_gmbi", prjres) %>% # subset(,subset="rls_all") # features ---- s_seamounts <- get_d_prjres("s_phys_seamounts",prjres) lu_seamounts <- c(lteq200m="0to200",gt200lteq800m="gt200to800",gt800m="gt800") lbls_seamounts <- sprintf("phys_seamounts_%sm", lu_seamounts[names(s_seamounts)]) # features ---- s_features <- stack( # get_d_prjres("r_vgpm", prjres), # s_bio_now, # rls_all, #raster(s_fish_gfw, "mean_scaled_profits_with_subsidies") %>% # gap_fill_raster() %>% # rescale_raster(inverse=T), #raster(s_fish_ubc, "mcp_2004"), s_seamounts, get_d_prjres("r_phys_vents",prjres)) # get_d_prjres("r_phys_scapes_hetero",prjres)) names(s_features) <- c( # "bio_vgpm", # names(s_bio_now), # "rls_all", #"fish_profit.subs" #"fish_mcp.2004", lbls_seamounts, "phys_vents") # "scapes_hetero") # problem ---- p <- problem(r_pu, s_features) %>% add_min_set_objective() %>% add_relative_targets(rel_target) # solve ---- tif <- solve_log(p, pfx, redo=redo) }
r basename(pfx)Projection: r P$name (r P$res resolution)
Planning unit cost: set to 1
Objective function:
add_min_set_objective(): Minimize the cost of the solution whilst ensuring that all targets are met Feature targets:
r rel_target*100% of each input feature amountphys_vents: hydrothermal vent countphys_seamounts: seamounts count (3 depth classes)Regionalization:
report_solution(tif, redo=redo)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.