Nothing
In wallace: A Modular Platform for Reproducible Modeling of Species Niches and Distributions
```{asis, echo = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & xfer_time_worldclim_knit}}, eval = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & xfer_time_worldclim_knit}}, include = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & xfer_time_worldclim_knit}}}
Transfer model
Transferring the model to the same modelling area with no threshold rule. New time based on {{envs_name_rmd}} variables for {{yearMin_rmd}} using a {{model_rmd}} GCM and an SSP of {{rcp_rmd}}.
```r}, include = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & xfer_time_worldclim_knit}}}
#Download variables for transferring
xferTimeEnvs_{{spAbr}} <- geodata::cmip6_world(
model = "{{model_rmd}}",
ssp = "{{rcp_rmd}}",
time = "{{year_rmd}}",
var = "bio",
res = round((raster::res(bgMask_{{spAbr}}) * 60)[1],1),
path = tempdir())
names(xferTimeEnvs_{{spAbr}}) <- paste0('bio', c(paste0('0',1:9), 10:19))
# Select variables for transferring to match variables used for modelling
xferTimeEnvs_{{spAbr}} <- xferTimeEnvs_{{spAbr}}[[names(bgMask_{{spAbr}})]]
# Convert to rasterstack
xferTimeEnvs_{{spAbr}} <- raster::stack(xferTimeEnvs_{{spAbr}})
# Generate a transfer of the model to the desired area and time
xfer_time_{{spAbr}} <-xfer_time(
evalOut = model_{{spAbr}},
curModel = "{{curModel_rmd}}",
envs = xferTimeEnvs_{{spAbr}},
xfExt = bgExt_{{spAbr}},
alg = "{{alg_rmd}}",
outputType = "{{outputType_rmd}}",
clamp = {{clamp_rmd}}
)
# store the cropped variables of transfer
xferExt_{{spAbr}} <- xfer_time_{{spAbr}}$xferExt
###Make map of transfer
bb_{{spAbr}} <- bgExt_{{spAbr}}@bbox
bbZoom <- polyZoom(bb_{{spAbr}}[1, 1], bb_{{spAbr}}[2, 1], bb_{{spAbr}}[1, 2],
bb_{{spAbr}}[2, 2], fraction = 0.05)
mapXferVals_{{spAbr}} <- getRasterVals(xfer_time_{{spAbr}}$xferTime,"{{outputType_rmd}}")
rasCols_{{spAbr}} <- c("#2c7bb6", "#abd9e9", "#ffffbf", "#fdae61", "#d7191c")
# if no threshold specified
legendPal <- colorNumeric(rev(rasCols_{{spAbr}}), mapXferVals_{{spAbr}}, na.color = 'transparent')
rasPal_{{spAbr}} <- colorNumeric(rasCols_{{spAbr}}, mapXferVals_{{spAbr}}, na.color = 'transparent')
m <- leaflet() %>% addProviderTiles(providers$Esri.WorldTopoMap)
m %>%
fitBounds(bbZoom[1], bbZoom[2], bbZoom[3], bbZoom[4]) %>%
leaflet::addLegend("bottomright", pal = legendPal,
title = "Predicted Suitability<br>(Transferred)",
values = mapXferVals_{{spAbr}}, layerId = 'xfer',
labFormat = reverseLabel(2, reverse_order = TRUE)) %>%
# map model prediction raster and polygon of transfer
clearMarkers() %>% clearShapes() %>% removeImage('xferRas') %>%
addRasterImage(xfer_time_{{spAbr}}$xferTime, colors = rasPal_{{spAbr}}, opacity = 0.7,
layerId = 'xferRas', group = 'xfer', method = "ngb") %>%
##add polygon of transfer (same modeling area)
addPolygons(data = bgExt_{{spAbr}}, fill = FALSE,
weight = 4, color = "blue", group = 'xfer')
```{asis, echo = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & xfer_time_worldclim_knit}}, eval = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & xfer_time_worldclim_knit}}, include = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & xfer_time_worldclim_knit}}}
Transfer model
Transferring the model to the same modelling area with a "{{xfer_thresholdRule_rmd}}" threshold rule of {{xfer_threshold_rmd}}. New time based on {{envs_name_rmd}} variables for {{yearMin_rmd}} using a {{model_rmd}} GCM and an SSP of {{rcp_rmd}}.
```r}, include = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & xfer_time_worldclim_knit}}}
#Download variables for transferring
xferTimeEnvs_{{spAbr}} <- geodata::cmip6_world(
model = "{{model_rmd}}",
ssp = "{{rcp_rmd}}",
time = "{{year_rmd}}",
var = "bio",
res = round((raster::res(bgMask_{{spAbr}}) * 60)[1],1),
path = tempdir())
names(xferTimeEnvs_{{spAbr}}) <- paste0('bio', c(paste0('0',1:9), 10:19))
# Select variables for transferring to match variables used for modelling
xferTimeEnvs_{{spAbr}} <- xferTimeEnvs_{{spAbr}}[[names(bgMask_{{spAbr}})]]
# Convert to rasterstack
xferTimeEnvs_{{spAbr}} <- raster::stack(xferTimeEnvs_{{spAbr}})
# Generate a transfer of the model to the desired area and time
xfer_time_{{spAbr}} <-xfer_time(
evalOut = model_{{spAbr}},
curModel = "{{curModel_rmd}}",
envs = xferTimeEnvs_{{spAbr}},
xfExt = bgExt_{{spAbr}},
alg = "{{alg_rmd}}",
outputType = "{{outputType_rmd}}",
clamp = {{clamp_rmd}}
)
# store the cropped variables of transfer
xferExt_{{spAbr}} <- xfer_time_{{spAbr}}$xferExt
# extract the suitability values for all occurrences
occs_xy_{{spAbr}} <- occs_{{spAbr}}[c('longitude', 'latitude')]
# determine the threshold based on the current prediction
occPredVals_{{spAbr}} <- raster::extract(predSel_{{spAbr}}, occs_xy_{{spAbr}})
# Define probability of quantile based on selected threshold
xfer_thresProb_{{spAbr}} <- switch("{{xfer_thresholdRule_rmd}}",
"mtp" = 0, "p10" = 0.1, "qtp" = {{xfer_probQuantile_rmd}})
# Add threshold if specified
xfer_time_{{spAbr}} <- xfer_time_{{spAbr}}$xferTime > xfer_thresProb_{{spAbr}}
##Make map
###Make map of transfer
bb_{{spAbr}} <- bgExt_{{spAbr}}@bbox
bbZoom <- polyZoom(bb_{{spAbr}}[1, 1], bb_{{spAbr}}[2, 1], bb_{{spAbr}}[1, 2],
bb_{{spAbr}}[2, 2], fraction = 0.05)
mapXferVals_{{spAbr}} <- getRasterVals(xfer_time_{{spAbr}},"{{outputType_rmd}}")
# if threshold specified
rasPal_{{spAbr}} <- c('gray', 'red')
m <- leaflet() %>% addProviderTiles(providers$Esri.WorldTopoMap)
m %>%
fitBounds(bbZoom[1], bbZoom[2], bbZoom[3], bbZoom[4]) %>%
leaflet::addLegend("bottomright", colors = c('gray', 'red'),
title = "Thresholded Suitability<br>(Transferred)",
labels = c("predicted absence", "predicted presence"),
opacity = 1, layerId = 'xfer')%>%
# map model prediction raster and polygon of transfer
clearMarkers() %>% clearShapes() %>% removeImage('xferRas') %>%
addRasterImage(xfer_time_{{spAbr}}, colors = rasPal_{{spAbr}}, opacity = 0.7,
layerId = 'xferRas', group = 'xfer', method = "ngb") %>%
##add polygon of transfer (same modeling area)
addPolygons(data = bgExt_{{spAbr}}, fill = FALSE,
weight = 4, color = "blue", group = 'xfer')
```{asis, echo = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & !xfer_time_threshold_knit & xfer_time_worldclim_knit}}, eval = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & !xfer_time_threshold_knit & xfer_time_worldclim_knit}}, include = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & !xfer_time_threshold_knit & xfer_time_worldclim_knit}}}
Transfer model
Transferring the model to a user drawn area with no threshold. New time based on {{envs_name_rmd}} variables for {{yearMin_rmd}} using a {{model_rmd}} GCM and an SSP of {{rcp_rmd}}.
```r}, include = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & !xfer_time_threshold_knit & xfer_time_worldclim_knit}}}
#Download variables for transferring
xferTimeEnvs_{{spAbr}} <- geodata::cmip6_world(
model = "{{model_rmd}}",
ssp = "{{rcp_rmd}}",
time = "{{year_rmd}}",
var = "bio",
res = round((raster::res(bgMask_{{spAbr}}) * 60)[1],1),
path = tempdir())
names(xferTimeEnvs_{{spAbr}}) <- paste0('bio', c(paste0('0',1:9), 10:19))
# Select variables for transferring to match variables used for modelling
xferTimeEnvs_{{spAbr}} <- xferTimeEnvs_{{spAbr}}[[names(bgMask_{{spAbr}})]]
# Convert to rasterstack
xferTimeEnvs_{{spAbr}} <- raster::stack(xferTimeEnvs_{{spAbr}})
# Generate the area of transfer according to the drawn polygon in the GUI
xfer_draw_{{spAbr}} <-xfer_draw(
polyXfXY = matrix({{polyXfXY_rmd}}, ncol = 2, byrow = FALSE),
polyXfID = {{polyXfID_rmd}},
drawXfBuf = {{BgBuf_rmd}})
# Generate a transfer of the model to the desired area and time
xfer_time_{{spAbr}} <-xfer_time(
evalOut = model_{{spAbr}},
curModel = "{{curModel_rmd}}",
envs = xferTimeEnvs_{{spAbr}},
xfExt = xfer_draw_{{spAbr}},
alg = "{{alg_rmd}}",
outputType = "{{outputType_rmd}}",
clamp = {{clamp_rmd}}
)
#store the cropped variables of transfer
xferExt_{{spAbr}} <- xfer_time_{{spAbr}}$xferExt
###Make map of transfer
bb_{{spAbr}} <- bgExt_{{spAbr}}@bbox
bbZoom <- polyZoom(bb_{{spAbr}}[1, 1], bb_{{spAbr}}[2, 1], bb_{{spAbr}}[1, 2],
bb_{{spAbr}}[2, 2], fraction = 0.05)
mapXferVals_{{spAbr}} <- getRasterVals(xfer_time_{{spAbr}}$xferTime,"{{outputType_rmd}}")
rasCols_{{spAbr}} <- c("#2c7bb6", "#abd9e9", "#ffffbf", "#fdae61", "#d7191c")
# if no threshold specified
legendPal <- colorNumeric(rev(rasCols_{{spAbr}}), mapXferVals_{{spAbr}}, na.color = 'transparent')
rasPal_{{spAbr}} <- colorNumeric(rasCols_{{spAbr}}, mapXferVals_{{spAbr}}, na.color = 'transparent')
m <- leaflet() %>% addProviderTiles(providers$Esri.WorldTopoMap)
m %>%
fitBounds(bbZoom[1], bbZoom[2], bbZoom[3], bbZoom[4]) %>%
leaflet::addLegend("bottomright", pal = legendPal,
title = "Predicted Suitability<br>(Transferred)",
values = mapXferVals_{{spAbr}}, layerId = 'xfer',
labFormat = reverseLabel(2, reverse_order = TRUE)) %>%
# map model prediction raster and polygon of transfer
clearMarkers() %>% clearShapes() %>% removeImage('xferRas') %>%
addRasterImage(xfer_time_{{spAbr}}$xferTime, colors = rasPal_{{spAbr}}, opacity = 0.7,
layerId = 'xferRas', group = 'xfer', method = "ngb") %>%
##add polygon of transfer (user drawn area)
addPolygons(data = xfer_draw_{{spAbr}}, fill = FALSE,
weight = 4, color = "blue", group = 'xfer')
```{asis, echo = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & xfer_time_threshold_knit & xfer_time_worldclim_knit}}, eval = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & xfer_time_threshold_knit & xfer_time_worldclim_knit}}, include = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & xfer_time_threshold_knit & xfer_time_worldclim_knit}}}
Transfer model
Transferring the model to a user drawn area with a "{{xfer_thresholdRule_rmd}}" threshold rule of {{xfer_threshold_rmd}}. New time based on {{envs_name_rmd}} variables for {{yearMin_rmd}} using a {{model_rmd}} GCM and an SSP of {{rcp_rmd}}.
```r}, include = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & xfer_time_threshold_knit & xfer_time_worldclim_knit}}}
#Download variables for transferring
xferTimeEnvs_{{spAbr}} <- geodata::cmip6_world(
model = "{{model_rmd}}",
ssp = "{{rcp_rmd}}",
time = "{{year_rmd}}",
var = "bio",
res = round((raster::res(bgMask_{{spAbr}}) * 60)[1],1),
path = tempdir())
names(xferTimeEnvs_{{spAbr}}) <- paste0('bio', c(paste0('0',1:9), 10:19))
# Select variables for transferring to match variables used for modelling
xferTimeEnvs_{{spAbr}} <- xferTimeEnvs_{{spAbr}}[[names(bgMask_{{spAbr}})]]
# Convert to rasterstack
xferTimeEnvs_{{spAbr}} <- raster::stack(xferTimeEnvs_{{spAbr}})
# Generate the area of transfer according to the drawn polygon in the GUI
xfer_draw_{{spAbr}} <-xfer_draw(
polyXfXY = matrix({{polyXfXY_rmd}},ncol=2,byrow=FALSE),
polyXfID = {{polyXfID_rmd}},
drawXfBuf = {{BgBuf_rmd}})
# Generate a transfer of the model to the desired area and time
xfer_time_{{spAbr}} <-xfer_time(
evalOut = model_{{spAbr}},
curModel = "{{curModel_rmd}}",
envs = xferTimeEnvs_{{spAbr}},
xfExt = xfer_draw_{{spAbr}},
alg = "{{alg_rmd}}",
outputType = "{{outputType_rmd}}",
clamp = {{clamp_rmd}}
)
# store the cropped variables of transfer
xferExt_{{spAbr}} <- xfer_time_{{spAbr}}$xferExt
# extract the suitability values for all occurrences
occs_xy_{{spAbr}} <- occs_{{spAbr}}[c('longitude', 'latitude')]
# determine the threshold based on the current prediction
occPredVals_{{spAbr}} <- raster::extract(predSel_{{spAbr}}, occs_xy_{{spAbr}})
# Define probability of quantile based on selected threshold
xfer_thresProb_{{spAbr}} <- switch("{{xfer_thresholdRule_rmd}}",
"mtp" = 0, "p10" = 0.1, "qtp" = {{xfer_probQuantile_rmd}})
# Add threshold if specified
xfer_time_{{spAbr}} <- xfer_time_{{spAbr}}$xferTime > xfer_thresProb_{{spAbr}}
##Make map
###Make map of transfer
bb_{{spAbr}} <- bgExt_{{spAbr}}@bbox
bbZoom <- polyZoom(bb_{{spAbr}}[1, 1], bb_{{spAbr}}[2, 1], bb_{{spAbr}}[1, 2],
bb_{{spAbr}}[2, 2], fraction = 0.05)
mapXferVals_{{spAbr}} <- getRasterVals(xfer_time_{{spAbr}},"{{outputType_rmd}}")
# if threshold specified
rasPal_{{spAbr}} <- c('gray', 'red')
m <- leaflet() %>% addProviderTiles(providers$Esri.WorldTopoMap)
m %>%
fitBounds(bbZoom[1], bbZoom[2], bbZoom[3], bbZoom[4]) %>%
leaflet::addLegend("bottomright", colors = c('gray', 'red'),
title = "Thresholded Suitability<br>(Transferred)",
labels = c("predicted absence", "predicted presence"),
opacity = 1, layerId = 'xfer') %>%
# map model prediction raster and polygon of transfer
clearMarkers() %>% clearShapes() %>% removeImage('xferRas') %>%
addRasterImage(xfer_time_{{spAbr}}, colors = rasPal_{{spAbr}}, opacity = 0.7,
layerId = 'xferRas', group = 'xfer', method = "ngb") %>%
##add polygon of transfer (user drawn area)
addPolygons(data = xfer_draw_{{spAbr}}, fill = FALSE,
weight = 4, color = "blue", group = 'xfer')
```{asis, echo = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & xfer_time_worldclim_knit}}, eval = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & xfer_time_worldclim_knit}}, include = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & xfer_time_worldclim_knit}}}
Transfer model
Transferring the model to a user provided area area with no threshold. New time based on {{envs_name_rmd}} variables for {{yearMin_rmd}} using a {{model_rmd}} GCM and an SSP of {{rcp_rmd}}.
```r}, include = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & xfer_time_worldclim_knit}}}
# Download variables for transferring
xferTimeEnvs_{{spAbr}} <- geodata::cmip6_world(
model = "{{model_rmd}}",
ssp = "{{rcp_rmd}}",
time = "{{year_rmd}}",
var = "bio",
res = round((raster::res(bgMask_{{spAbr}}) * 60)[1],1),
path = tempdir())
names(xferTimeEnvs_{{spAbr}}) <- paste0('bio', c(paste0('0',1:9), 10:19))
# Select variables for transferring to match variables used for modelling
xferTimeEnvs_{{spAbr}} <- xferTimeEnvs_{{spAbr}}[[names(bgMask_{{spAbr}})]]
# Convert to rasterstack
xferTimeEnvs_{{spAbr}} <- raster::stack(xferTimeEnvs_{{spAbr}})
# Generate the area of transfer based on user provided files
##User must input the path to shapefile or csv file and the file name
xfer_userExt_{{spAbr}} <- xfer_userExtent(
bgShp_path = "Input path here",
bgShp_name = "Input file name here",
userBgBuf = {{BgBuf_rmd}})
# Generate a transfer of the model to the desired area and time
xfer_time_{{spAbr}} <-xfer_time(
evalOut = model_{{spAbr}},
curModel = "{{curModel_rmd}}",
envs = xferTimeEnvs_{{spAbr}},
xfExt = xfer_userExt_{{spAbr}},
alg = "{{alg_rmd}}",
outputType = "{{outputType_rmd}}",
clamp = {{clamp_rmd}}
)
# store the cropped variables of transfer
xferExt_{{spAbr}} <- xfer_time_{{spAbr}}$xferExt
###Make map of transfer
bb_{{spAbr}} <- bgExt_{{spAbr}}@bbox
bbZoom <- polyZoom(bb_{{spAbr}}[1, 1], bb_{{spAbr}}[2, 1], bb_{{spAbr}}[1, 2],
bb_{{spAbr}}[2, 2], fraction = 0.05)
mapXferVals_{{spAbr}} <- getRasterVals(xfer_time_{{spAbr}}$xferTime,"{{outputType_rmd}}")
rasCols_{{spAbr}} <- c("#2c7bb6", "#abd9e9", "#ffffbf", "#fdae61", "#d7191c")
# if no threshold specified
legendPal <- colorNumeric(rev(rasCols_{{spAbr}}), mapXferVals_{{spAbr}},
na.color = 'transparent')
rasPal_{{spAbr}} <- colorNumeric(rasCols_{{spAbr}}, mapXferVals_{{spAbr}},
na.color = 'transparent')
m <- leaflet() %>% addProviderTiles(providers$Esri.WorldTopoMap)
m %>%
fitBounds(bbZoom[1], bbZoom[2], bbZoom[3], bbZoom[4]) %>%
leaflet::addLegend("bottomright", pal = legendPal,
title = "Predicted Suitability<br>(Transferred)",
values = mapXferVals_{{spAbr}}, layerId = 'xfer',
labFormat = reverseLabel(2, reverse_order = TRUE)) %>%
# map model prediction raster and polygon of transfer
clearMarkers() %>% clearShapes() %>% removeImage('xferRas') %>%
addRasterImage(xfer_time_{{spAbr}}$xferTime, colors = rasPal_{{spAbr}}, opacity = 0.7,
layerId = 'xferRas', group = 'xfer', method = "ngb") %>%
##add polygon of transfer (user provided area)
addPolygons(data = xfer_userExt_{{spAbr}}, fill = FALSE,
weight = 4, color = "blue", group = 'xfer')
```{asis, echo = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & xfer_time_worldclim_knit}}, eval = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & xfer_time_worldclim_knit}}, include = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & xfer_time_worldclim_knit}}}
Transfer model
Transferring the model to a user provided area with a "{{xfer_thresholdRule_rmd}}" threshold rule of {{xfer_threshold_rmd}}. New time based on {{envs_name_rmd}} variables for {{yearMin_rmd}} using a {{model_rmd}} GCM and an SSP of {{rcp_rmd}}.
```r}, include = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & xfer_time_worldclim_knit}}}
# Download variables for transferring from Worldclim
xferTimeEnvs_{{spAbr}} <- geodata::cmip6_world(
model = "{{model_rmd}}",
ssp = "{{rcp_rmd}}",
time = "{{year_rmd}}",
var = "bio",
res = round((raster::res(bgMask_{{spAbr}}) * 60)[1],1),
path = tempdir())
names(xferTimeEnvs_{{spAbr}}) <- paste0('bio', c(paste0('0',1:9), 10:19))
# Select variables for transferring to match variables used for modelling
xferTimeEnvs_{{spAbr}} <- xferTimeEnvs_{{spAbr}}[[names(bgMask_{{spAbr}})]]
# Convert to rasterstack
xferTimeEnvs_{{spAbr}} <- raster::stack(xferTimeEnvs_{{spAbr}})
# Generate the area of transfer based on user provided files
##User must input the path to shapefile or csv file and the file name
xfer_userExt_{{spAbr}} <- xfer_userExtent(
bgShp_path = "Input path here",
bgShp_name = "Input file name here",
userBgBuf = {{BgBuf_rmd}})
# Generate a transfer of the model to the desired area and time
xfer_time_{{spAbr}} <-xfer_time(
evalOut = model_{{spAbr}},
curModel = "{{curModel_rmd}}",
envs = xferTimeEnvs_{{spAbr}},
xfExt = xfer_userExt_{{spAbr}},
alg = "{{alg_rmd}}",
outputType = "{{outputType_rmd}}",
clamp = {{clamp_rmd}}
)
# store the cropped variables of transfer
xferExt_{{spAbr}} <- xfer_time_{{spAbr}}$xferExt
# extract the suitability values for all occurrences
occs_xy_{{spAbr}} <- occs_{{spAbr}}[c('longitude', 'latitude')]
# determine the threshold based on the current prediction
occPredVals_{{spAbr}} <- raster::extract(predSel_{{spAbr}}, occs_xy_{{spAbr}})
# Define probability of quantile based on selected threshold
xfer_thresProb_{{spAbr}} <- switch("{{xfer_thresholdRule_rmd}}",
"mtp" = 0, "p10" = 0.1, "qtp" = {{xfer_probQuantile_rmd}})
# Add threshold if specified
xfer_time_{{spAbr}} <- xfer_time_{{spAbr}}$xferTime > xfer_thresProb_{{spAbr}}
##Make map
###Make map of transfer
bb_{{spAbr}} <- bgExt_{{spAbr}}@bbox
bbZoom <- polyZoom(bb_{{spAbr}}[1, 1], bb_{{spAbr}}[2, 1], bb_{{spAbr}}[1, 2],
bb_{{spAbr}}[2, 2], fraction = 0.05)
mapXferVals_{{spAbr}} <- getRasterVals(xfer_time_{{spAbr}},"{{outputType_rmd}}")
# if threshold specified
rasPal_{{spAbr}} <- c('gray', 'red')
m <- leaflet() %>% addProviderTiles(providers$Esri.WorldTopoMap)
m %>%
fitBounds(bbZoom[1], bbZoom[2], bbZoom[3], bbZoom[4]) %>%
leaflet::addLegend("bottomright", colors = c('gray', 'red'),
title = "Thresholded Suitability<br>(Transferred)",
labels = c("predicted absence", "predicted presence"),
opacity = 1, layerId = 'xfer')%>%
# map model prediction raster and polygon of transfer
clearMarkers() %>% clearShapes() %>% removeImage('xferRas') %>%
addRasterImage(xfer_time_{{spAbr}}, colors = rasPal_{{spAbr}}, opacity = 0.7,
layerId = 'xferRas', group = 'xfer', method = "ngb") %>%
##add polygon of transfer (user provided area)
addPolygons(data = xfer_userExt_{{spAbr}}, fill = FALSE,
weight = 4, color = "blue", group = 'xfer')
```{asis, echo = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & !xfer_time_worldclim_knit}}, eval = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & !xfer_time_worldclim_knit}}, include = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & !xfer_time_worldclim_knit}}}
Transfer model
Transferring the model to the same modelling area with no threshold rule. New time based on "{{envs_name_rmd}}" variables for {{yearMin_rmd}} to {{yearMax_rmd}} using a "{{xfAOGCM_rmd}}" GCM and a "{{xfScenario_rmd}}" scenario.
```r}, include = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & !xfer_time_worldclim_knit}}}
#Download data from ecoClimate for transferring
xferTimeEnvs_{{spAbr}} <- envs_ecoClimate(
"{{xfAOGCM_rmd}}",
"{{xfScenario_rmd}}",
as.numeric(gsub("bio", "", names(bgMask_{{spAbr}}))))
# Generate a transfer of the model to the desired area and time
xfer_time_{{spAbr}} <-xfer_time(
evalOut = model_{{spAbr}},
curModel = "{{curModel_rmd}}",
envs = xferTimeEnvs_{{spAbr}} ,
xfExt = bgExt_{{spAbr}},
alg = "{{alg_rmd}}",
outputType = "{{outputType_rmd}}",
clamp = {{clamp_rmd}}
)
#store the cropped variables of transfer
xferExt_{{spAbr}} <- xfer_time_{{spAbr}}$xferExt
###Make map of transfer
bb_{{spAbr}} <- bgExt_{{spAbr}}@bbox
bbZoom <- polyZoom(bb_{{spAbr}}[1, 1], bb_{{spAbr}}[2, 1], bb_{{spAbr}}[1, 2],
bb_{{spAbr}}[2, 2], fraction = 0.05)
mapXferVals_{{spAbr}} <- getRasterVals(xfer_time_{{spAbr}}$xferTime,"{{outputType_rmd}}")
rasCols_{{spAbr}} <- c("#2c7bb6", "#abd9e9", "#ffffbf", "#fdae61", "#d7191c")
# if no threshold specified
legendPal <- colorNumeric(rev(rasCols_{{spAbr}}), mapXferVals_{{spAbr}},
na.color = 'transparent')
rasPal_{{spAbr}} <- colorNumeric(rasCols_{{spAbr}}, mapXferVals_{{spAbr}},
na.color = 'transparent')
m <- leaflet() %>% addProviderTiles(providers$Esri.WorldTopoMap)
m %>%
fitBounds(bbZoom[1], bbZoom[2], bbZoom[3], bbZoom[4]) %>%
leaflet::addLegend("bottomright", pal = legendPal,
title = "Predicted Suitability<br>(Transferred)",
values = mapXferVals_{{spAbr}}, layerId = 'xfer',
labFormat = reverseLabel(2, reverse_order = TRUE)) %>%
# map model prediction raster and polygon of transfer
clearMarkers() %>% clearShapes() %>% removeImage('xferRas') %>%
addRasterImage(xfer_time_{{spAbr}}$xferTime, colors = rasPal_{{spAbr}}, opacity = 0.7,
layerId = 'xferRas', group = 'xfer', method = "ngb") %>%
##add polygon of transfer (same modeling area)
addPolygons(data = bgExt_{{spAbr}}, fill = FALSE,
weight = 4, color = "blue", group = 'xfer')
```{asis, echo = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & !xfer_time_worldclim_knit}}, eval = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & !xfer_time_worldclim_knit}}, include = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & !xfer_time_worldclim_knit}}}
Transfer model
Transferring the model to the same modelling area with a "{{xfer_thresholdRule_rmd}}" threshold rule of {{xfer_threshold_rmd}}. New time based on "{{envs_name_rmd}}" variables for {{yearMin_rmd}} to {{yearMax_rmd}} using a "{{xfAOGCM_rmd}}" GCM and a "{{xfScenario_rmd}}" scenario.
```r}, include = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & !xfer_time_worldclim_knit}}}
#Download data from ecoClimate for transferring
xferTimeEnvs_{{spAbr}} <- envs_ecoClimate(
"{{xfAOGCM_rmd}}",
"{{xfScenario_rmd}}",
as.numeric(gsub("bio", "", names(bgMask_{{spAbr}}))))
# Generate a transfer of the model to the desired area and time
xfer_time_{{spAbr}} <-xfer_time(
evalOut = model_{{spAbr}},
curModel = "{{curModel_rmd}}",
envs = xferTimeEnvs_{{spAbr}} ,
xfExt = bgExt_{{spAbr}},
alg = "{{alg_rmd}}",
outputType = "{{outputType_rmd}}",
clamp = {{clamp_rmd}}
)
# store the cropped variables of transfer
xferExt_{{spAbr}} <- xfer_time_{{spAbr}}$xferExt
# extract the suitability values for all occurrences
occs_xy_{{spAbr}} <- occs_{{spAbr}}[c('longitude', 'latitude')]
# determine the threshold based on the current prediction
occPredVals_{{spAbr}} <- raster::extract(predSel_{{spAbr}}, occs_xy_{{spAbr}})
# Define probability of quantile based on selected threshold
xfer_thresProb_{{spAbr}} <- switch("{{xfer_thresholdRule_rmd}}",
"mtp" = 0, "p10" = 0.1, "qtp" = {{xfer_probQuantile_rmd}})
# Add threshold if specified
xfer_time_{{spAbr}} <- xfer_time_{{spAbr}}$xferTime > xfer_thresProb_{{spAbr}}
##Make map
###Make map of transfer
bb_{{spAbr}} <- bgExt_{{spAbr}}@bbox
bbZoom <- polyZoom(bb_{{spAbr}}[1, 1], bb_{{spAbr}}[2, 1], bb_{{spAbr}}[1, 2],
bb_{{spAbr}}[2, 2], fraction = 0.05)
mapXferVals_{{spAbr}} <- getRasterVals(xfer_time_{{spAbr}},"{{outputType_rmd}}")
# if threshold specified
rasPal_{{spAbr}} <- c('gray', 'red')
m <- leaflet() %>% addProviderTiles(providers$Esri.WorldTopoMap)
m %>%
fitBounds(bbZoom[1], bbZoom[2], bbZoom[3], bbZoom[4]) %>%
leaflet::addLegend("bottomright", colors = c('gray', 'red'),
title = "Thresholded Suitability<br>(Transferred)",
labels = c("predicted absence", "predicted presence"),
opacity = 1, layerId = 'xfer') %>%
# map model prediction raster and polygon of transfer
clearMarkers() %>% clearShapes() %>% removeImage('xferRas') %>%
addRasterImage(xfer_time_{{spAbr}}, colors = rasPal_{{spAbr}}, opacity = 0.7,
layerId = 'xferRas', group = 'xfer', method = "ngb") %>%
##add polygon of transfer (same modeling area)
addPolygons(data = bgExt_{{spAbr}}, fill = FALSE,
weight = 4, color = "blue", group = 'xfer')
```{asis, echo = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & !xfer_time_threshold_knit & !xfer_time_worldclim_knit}}, eval = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & !xfer_time_threshold_knit & !xfer_time_worldclim_knit}}, include = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & !xfer_time_threshold_knit & !xfer_time_worldclim_knit}}}
Transfer model
Transferring the model to a user drawn area with no threshold rule. New time based on "{{envs_name_rmd}}" variables for {{yearMin_rmd}} to {{yearMax_rmd}} using a "{{xfAOGCM_rmd}}" GCM and a "{{xfScenario_rmd}}" scenario.
```r}, include = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & !xfer_time_threshold_knit & !xfer_time_worldclim_knit}}}
#Download data from ecoClimate for transferring
xferTimeEnvs_{{spAbr}} <- envs_ecoClimate(
"{{xfAOGCM_rmd}}",
"{{xfScenario_rmd}}",
as.numeric(gsub("bio", "", names(bgMask_{{spAbr}}))))
# Generate the area of transfer according to the drawn polygon in the GUI
xfer_draw_{{spAbr}} <-xfer_draw(
polyXfXY = matrix({{polyXfXY_rmd}},ncol=2,byrow=FALSE),
polyXfID = {{polyXfID_rmd}},
drawXfBuf = {{BgBuf_rmd}})
# Generate a transfer of the model to the desired area and time
xfer_time_{{spAbr}} <-xfer_time(
evalOut = model_{{spAbr}},
curModel = "{{curModel_rmd}}",
envs = xferTimeEnvs_{{spAbr}},
xfExt = xfer_draw_{{spAbr}},
alg = "{{alg_rmd}}",
outputType = "{{outputType_rmd}}",
clamp = {{clamp_rmd}}
)
# Store the cropped variables of transfer
xferExt_{{spAbr}} <- xfer_time_{{spAbr}}$xferExt
###Make map of transfer
bb_{{spAbr}} <- bgExt_{{spAbr}}@bbox
bbZoom <- polyZoom(bb_{{spAbr}}[1, 1], bb_{{spAbr}}[2, 1], bb_{{spAbr}}[1, 2],
bb_{{spAbr}}[2, 2], fraction = 0.05)
mapXferVals_{{spAbr}} <- getRasterVals(xfer_time_{{spAbr}}$xferTime,"{{outputType_rmd}}")
rasCols_{{spAbr}} <- c("#2c7bb6", "#abd9e9", "#ffffbf", "#fdae61", "#d7191c")
# if no threshold specified
legendPal <- colorNumeric(rev(rasCols_{{spAbr}}), mapXferVals_{{spAbr}}, na.color = 'transparent')
rasPal_{{spAbr}} <- colorNumeric(rasCols_{{spAbr}}, mapXferVals_{{spAbr}}, na.color = 'transparent')
m <- leaflet() %>% addProviderTiles(providers$Esri.WorldTopoMap)
m %>%
fitBounds(bbZoom[1], bbZoom[2], bbZoom[3], bbZoom[4]) %>%
leaflet::addLegend("bottomright", pal = legendPal,
title = "Predicted Suitability<br>(Transferred)",
values = mapXferVals_{{spAbr}}, layerId = 'xfer',
labFormat = reverseLabel(2, reverse_order = TRUE)) %>%
# map model prediction raster and polygon of transfer
clearMarkers() %>% clearShapes() %>% removeImage('xferRas') %>%
addRasterImage(xfer_time_{{spAbr}}$xferTime, colors = rasPal_{{spAbr}}, opacity = 0.7,
layerId = 'xferRas', group = 'xfer', method = "ngb") %>%
##add polygon of transfer (user drawn area)
addPolygons(data = xfer_draw_{{spAbr}}, fill = FALSE,
weight = 4, color = "blue", group = 'xfer')
```{asis, echo = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & xfer_time_threshold_knit & !xfer_time_worldclim_knit}}, eval = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & xfer_time_threshold_knit & !xfer_time_worldclim_knit}}, include = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & xfer_time_threshold_knit & !xfer_time_worldclim_knit}}}
Transfer model
Transferring the model to a user drawn area with a "{{xfer_thresholdRule_rmd}}" threshold rule of {{xfer_threshold_rmd}}. New time based on "{{envs_name_rmd}}" variables for {{yearMin_rmd}} to {{yearMax_rmd}} using a "{{xfAOGCM_rmd}}" GCM and a "{{xfScenario_rmd}}" scenario.
```r}, include = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & xfer_time_threshold_knit & !xfer_time_worldclim_knit}}}
#Download data from ecoClimate for transferring
xferTimeEnvs_{{spAbr}} <- envs_ecoClimate(
"{{xfAOGCM_rmd}}",
"{{xfScenario_rmd}}",
as.numeric(gsub("bio", "", names(bgMask_{{spAbr}}))))
# Generate the area of transfer according to the drawn polygon in the GUI
xfer_draw_{{spAbr}} <-xfer_draw(
polyXfXY = matrix({{polyXfXY_rmd}},ncol=2,byrow=FALSE),
polyXfID = {{polyXfID_rmd}},
drawXfBuf = {{BgBuf_rmd}})
# Generate a transfer of the model to the desired area and time
xfer_time_{{spAbr}} <-xfer_time(
evalOut = model_{{spAbr}},
curModel = "{{curModel_rmd}}",
envs = xferTimeEnvs_{{spAbr}},
xfExt = xfer_draw_{{spAbr}},
alg = "{{alg_rmd}}",
outputType = "{{outputType_rmd}}",
clamp = {{clamp_rmd}}
)
# store the cropped variables of transfer
xferExt_{{spAbr}} <- xfer_time_{{spAbr}}$xferExt
# extract the suitability values for all occurrences
occs_xy_{{spAbr}} <- occs_{{spAbr}}[c('longitude', 'latitude')]
# determine the threshold based on the current prediction
occPredVals_{{spAbr}} <- raster::extract(predSel_{{spAbr}}, occs_xy_{{spAbr}})
# Define probability of quantile based on selected threshold
xfer_thresProb_{{spAbr}} <- switch("{{xfer_thresholdRule_rmd}}",
"mtp" = 0, "p10" = 0.1, "qtp" = {{xfer_probQuantile_rmd}})
# Add threshold if specified
xfer_time_{{spAbr}} <- xfer_time_{{spAbr}}$xferTime > xfer_thresProb_{{spAbr}}
##Make map
###Make map of transfer
bb_{{spAbr}} <- bgExt_{{spAbr}}@bbox
bbZoom <- polyZoom(bb_{{spAbr}}[1, 1], bb_{{spAbr}}[2, 1], bb_{{spAbr}}[1, 2],
bb_{{spAbr}}[2, 2], fraction = 0.05)
mapXferVals_{{spAbr}} <- getRasterVals(xfer_time_{{spAbr}},"{{outputType_rmd}}")
# if threshold specified
rasPal_{{spAbr}} <- c('gray', 'red')
m <- leaflet() %>% addProviderTiles(providers$Esri.WorldTopoMap)
m %>%
fitBounds(bbZoom[1], bbZoom[2], bbZoom[3], bbZoom[4]) %>%
leaflet::addLegend("bottomright", colors = c('gray', 'red'),
title = "Thresholded Suitability<br>(Transferred)",
labels = c("predicted absence", "predicted presence"),
opacity = 1, layerId = 'xfer')%>%
# map model prediction raster and polygon of transfer
clearMarkers() %>% clearShapes() %>% removeImage('xferRas') %>%
addRasterImage(xfer_time_{{spAbr}}, colors = rasPal_{{spAbr}}, opacity = 0.7,
layerId = 'xferRas', group = 'xfer', method = "ngb") %>%
##add polygon of transfer (user drawn area)
addPolygons(data = xfer_draw_{{spAbr}}, fill = FALSE,
weight = 4, color = "blue", group = 'xfer')
```{asis, echo = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & !xfer_time_worldclim_knit}}, eval = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & !xfer_time_worldclim_knit}}, include = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & !xfer_time_worldclim_knit}}}
Transfer model
Transferring the model to a user provided area with no threshold rule. New time based on "{{envs_name_rmd}}" variables for {{yearMin_rmd}} to {{yearMax_rmd}} using a "{{xfAOGCM_rmd}}" GCM and a "{{xfScenario_rmd}}" scenario.
```r}, include = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & !xfer_time_worldclim_knit}}}
#Download data from ecoClimate for transferring
xferTimeEnvs_{{spAbr}} <- envs_ecoClimate(
"{{xfAOGCM_rmd}}",
"{{xfScenario_rmd}}",
as.numeric(gsub("bio", "", names(bgMask_{{spAbr}}))))
# Generate the area of transfer based on user provided files
##User must input the path to shapefile or csv file and the file name
xfer_userExt_{{spAbr}} <- xfer_userExtent(
bgShp_path = "Input path here",
bgShp_name = "Input file name here",
userBgBuf = {{BgBuf_rmd}})
# Generate a transfer of the model to the desired area and time
xfer_time_{{spAbr}} <-xfer_time(
evalOut = model_{{spAbr}},
curModel = "{{curModel_rmd}}",
envs = xferTimeEnvs_{{spAbr}},
xfExt = xfer_userExt_{{spAbr}},
alg = "{{alg_rmd}}",
outputType = "{{outputType_rmd}}",
clamp = {{clamp_rmd}}
)
# store the cropped variables of transfer
xferExt_{{spAbr}} <- xfer_time_{{spAbr}}$xferExt
###Make map of transfer
bb_{{spAbr}} <- bgExt_{{spAbr}}@bbox
bbZoom <- polyZoom(bb_{{spAbr}}[1, 1], bb_{{spAbr}}[2, 1], bb_{{spAbr}}[1, 2],
bb_{{spAbr}}[2, 2], fraction = 0.05)
mapXferVals_{{spAbr}} <- getRasterVals(xfer_time_{{spAbr}}$xferTime,"{{outputType_rmd}}")
rasCols_{{spAbr}} <- c("#2c7bb6", "#abd9e9", "#ffffbf", "#fdae61", "#d7191c")
# if no threshold specified
legendPal <- colorNumeric(rev(rasCols_{{spAbr}}), mapXferVals_{{spAbr}},
na.color = 'transparent')
rasPal_{{spAbr}} <- colorNumeric(rasCols_{{spAbr}}, mapXferVals_{{spAbr}},
na.color = 'transparent')
m <- leaflet() %>% addProviderTiles(providers$Esri.WorldTopoMap)
m %>%
fitBounds(bbZoom[1], bbZoom[2], bbZoom[3], bbZoom[4]) %>%
leaflet::addLegend("bottomright", pal = legendPal,
title = "Predicted Suitability<br>(Transferred)",
values = mapXferVals_{{spAbr}}, layerId = 'xfer',
labFormat = reverseLabel(2, reverse_order = TRUE)) %>%
# map model prediction raster and polygon of transfer
clearMarkers() %>% clearShapes() %>% removeImage('xferRas') %>%
addRasterImage(xfer_time_{{spAbr}}$xferTime, colors = rasPal_{{spAbr}}, opacity = 0.7,
layerId = 'xferRas', group = 'xfer', method = "ngb") %>%
##add polygon of transfer (user provided area)
addPolygons(data = xfer_userExt_{{spAbr}}, fill = FALSE,
weight = 4, color = "blue", group = 'xfer')
```{asis, echo = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & !xfer_time_worldclim_knit}}, eval = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & !xfer_time_worldclim_knit}}, include = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & !xfer_time_worldclim_knit}}}
Transfer model
Transferring the model to a user provided area with a "{{xfer_thresholdRule_rmd}}" threshold rule of {{xfer_threshold_rmd}}. New time based on "{{envs_name_rmd}}" variables for {{yearMin_rmd}} to {{yearMax_rmd}} using a "{{xfAOGCM_rmd}}" GCM and a "{{xfScenario_rmd}}" scenario.
```r}, include = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & !xfer_time_worldclim_knit}}}
#Download data from ecoClimate for transferring
xferTimeEnvs_{{spAbr}} <- envs_ecoClimate(
"{{xfAOGCM_rmd}}",
"{{xfScenario_rmd}}",
as.numeric(gsub("bio", "", names(bgMask_{{spAbr}}))))
# Generate the area of transfer based on user provided files
##User must input the path to shapefile or csv file and the file name
xfer_userExt_{{spAbr}} <- xfer_userExtent(
bgShp_path = "Input path here",
bgShp_name = "Input file name here",
userBgBuf = {{BgBuf_rmd}})
# Generate a transfer of the model to the desired area and time
xfer_time_{{spAbr}} <-xfer_time(
evalOut = model_{{spAbr}},
curModel = "{{curModel_rmd}}",
envs = xferTimeEnvs_{{spAbr}},
xfExt = xfer_userExt_{{spAbr}},
alg = "{{alg_rmd}}",
outputType = "{{outputType_rmd}}",
clamp = {{clamp_rmd}}
)
# store the cropped variables of transfer
xferExt_{{spAbr}} <- xfer_time_{{spAbr}}$xferExt
# extract the suitability values for all occurrences
occs_xy_{{spAbr}} <- occs_{{spAbr}}[c('longitude', 'latitude')]
# determine the threshold based on the current prediction
occPredVals_{{spAbr}} <- raster::extract(predSel_{{spAbr}}, occs_xy_{{spAbr}})
# Define probability of quantile based on selected threshold
xfer_thresProb_{{spAbr}} <- switch("{{xfer_thresholdRule_rmd}}",
"mtp" = 0, "p10" = 0.1, "qtp" = {{xfer_probQuantile_rmd}})
# Add threshold if specified
xfer_time_{{spAbr}} <- xfer_time_{{spAbr}}$xferTime > xfer_thresProb_{{spAbr}}
##Make map
###Make map of transfer
bb_{{spAbr}} <- bgExt_{{spAbr}}@bbox
bbZoom <- polyZoom(bb_{{spAbr}}[1, 1], bb_{{spAbr}}[2, 1], bb_{{spAbr}}[1, 2],
bb_{{spAbr}}[2, 2], fraction = 0.05)
mapXferVals_{{spAbr}} <- getRasterVals(xfer_time_{{spAbr}},"{{outputType_rmd}}")
# if threshold specified
rasPal_{{spAbr}} <- c('gray', 'red')
m <- leaflet() %>% addProviderTiles(providers$Esri.WorldTopoMap)
m %>%
fitBounds(bbZoom[1], bbZoom[2], bbZoom[3], bbZoom[4]) %>%
leaflet::addLegend("bottomright", colors = c('gray', 'red'),
title = "Thresholded Suitability<br>(Transferred)",
labels = c("predicted absence", "predicted presence"),
opacity = 1, layerId = 'xfer')%>%
# map model prediction raster and polygon of transfer
clearMarkers() %>% clearShapes() %>% removeImage('xferRas') %>%
addRasterImage(xfer_time_{{spAbr}}, colors = rasPal_{{spAbr}}, opacity = 0.7,
layerId = 'xferRas', group = 'xfer', method = "ngb") %>%
##add polygon of transfer (user provided area)
addPolygons(data = xfer_userExt_{{spAbr}}, fill = FALSE,
weight = 4, color = "blue", group = 'xfer')
Try the wallace package in your browser
Any scripts or data that you put into this service are public.
wallace documentation built on Sept. 11, 2024, 9:16 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
```{asis, echo = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & xfer_time_worldclim_knit}}, eval = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & xfer_time_worldclim_knit}}, include = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & xfer_time_worldclim_knit}}}
Transfer model
Transferring the model to the same modelling area with no threshold rule. New time based on {{envs_name_rmd}} variables for {{yearMin_rmd}} using a {{model_rmd}} GCM and an SSP of {{rcp_rmd}}.
```r}, include = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & xfer_time_worldclim_knit}}} #Download variables for transferring xferTimeEnvs_{{spAbr}} <- geodata::cmip6_world( model = "{{model_rmd}}", ssp = "{{rcp_rmd}}", time = "{{year_rmd}}", var = "bio", res = round((raster::res(bgMask_{{spAbr}}) * 60)[1],1), path = tempdir()) names(xferTimeEnvs_{{spAbr}}) <- paste0('bio', c(paste0('0',1:9), 10:19)) # Select variables for transferring to match variables used for modelling xferTimeEnvs_{{spAbr}} <- xferTimeEnvs_{{spAbr}}[[names(bgMask_{{spAbr}})]] # Convert to rasterstack xferTimeEnvs_{{spAbr}} <- raster::stack(xferTimeEnvs_{{spAbr}}) # Generate a transfer of the model to the desired area and time xfer_time_{{spAbr}} <-xfer_time( evalOut = model_{{spAbr}}, curModel = "{{curModel_rmd}}", envs = xferTimeEnvs_{{spAbr}}, xfExt = bgExt_{{spAbr}}, alg = "{{alg_rmd}}", outputType = "{{outputType_rmd}}", clamp = {{clamp_rmd}} ) # store the cropped variables of transfer xferExt_{{spAbr}} <- xfer_time_{{spAbr}}$xferExt ###Make map of transfer bb_{{spAbr}} <- bgExt_{{spAbr}}@bbox bbZoom <- polyZoom(bb_{{spAbr}}[1, 1], bb_{{spAbr}}[2, 1], bb_{{spAbr}}[1, 2], bb_{{spAbr}}[2, 2], fraction = 0.05) mapXferVals_{{spAbr}} <- getRasterVals(xfer_time_{{spAbr}}$xferTime,"{{outputType_rmd}}") rasCols_{{spAbr}} <- c("#2c7bb6", "#abd9e9", "#ffffbf", "#fdae61", "#d7191c") # if no threshold specified legendPal <- colorNumeric(rev(rasCols_{{spAbr}}), mapXferVals_{{spAbr}}, na.color = 'transparent') rasPal_{{spAbr}} <- colorNumeric(rasCols_{{spAbr}}, mapXferVals_{{spAbr}}, na.color = 'transparent') m <- leaflet() %>% addProviderTiles(providers$Esri.WorldTopoMap) m %>% fitBounds(bbZoom[1], bbZoom[2], bbZoom[3], bbZoom[4]) %>% leaflet::addLegend("bottomright", pal = legendPal, title = "Predicted Suitability<br>(Transferred)", values = mapXferVals_{{spAbr}}, layerId = 'xfer', labFormat = reverseLabel(2, reverse_order = TRUE)) %>% # map model prediction raster and polygon of transfer clearMarkers() %>% clearShapes() %>% removeImage('xferRas') %>% addRasterImage(xfer_time_{{spAbr}}$xferTime, colors = rasPal_{{spAbr}}, opacity = 0.7, layerId = 'xferRas', group = 'xfer', method = "ngb") %>% ##add polygon of transfer (same modeling area) addPolygons(data = bgExt_{{spAbr}}, fill = FALSE, weight = 4, color = "blue", group = 'xfer')
```{asis, echo = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & xfer_time_worldclim_knit}}, eval = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & xfer_time_worldclim_knit}}, include = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & xfer_time_worldclim_knit}}}
Transfer model
Transferring the model to the same modelling area with a "{{xfer_thresholdRule_rmd}}" threshold rule of {{xfer_threshold_rmd}}. New time based on {{envs_name_rmd}} variables for {{yearMin_rmd}} using a {{model_rmd}} GCM and an SSP of {{rcp_rmd}}.
```r}, include = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & xfer_time_worldclim_knit}}} #Download variables for transferring xferTimeEnvs_{{spAbr}} <- geodata::cmip6_world( model = "{{model_rmd}}", ssp = "{{rcp_rmd}}", time = "{{year_rmd}}", var = "bio", res = round((raster::res(bgMask_{{spAbr}}) * 60)[1],1), path = tempdir()) names(xferTimeEnvs_{{spAbr}}) <- paste0('bio', c(paste0('0',1:9), 10:19)) # Select variables for transferring to match variables used for modelling xferTimeEnvs_{{spAbr}} <- xferTimeEnvs_{{spAbr}}[[names(bgMask_{{spAbr}})]] # Convert to rasterstack xferTimeEnvs_{{spAbr}} <- raster::stack(xferTimeEnvs_{{spAbr}}) # Generate a transfer of the model to the desired area and time xfer_time_{{spAbr}} <-xfer_time( evalOut = model_{{spAbr}}, curModel = "{{curModel_rmd}}", envs = xferTimeEnvs_{{spAbr}}, xfExt = bgExt_{{spAbr}}, alg = "{{alg_rmd}}", outputType = "{{outputType_rmd}}", clamp = {{clamp_rmd}} ) # store the cropped variables of transfer xferExt_{{spAbr}} <- xfer_time_{{spAbr}}$xferExt # extract the suitability values for all occurrences occs_xy_{{spAbr}} <- occs_{{spAbr}}[c('longitude', 'latitude')] # determine the threshold based on the current prediction occPredVals_{{spAbr}} <- raster::extract(predSel_{{spAbr}}, occs_xy_{{spAbr}}) # Define probability of quantile based on selected threshold xfer_thresProb_{{spAbr}} <- switch("{{xfer_thresholdRule_rmd}}", "mtp" = 0, "p10" = 0.1, "qtp" = {{xfer_probQuantile_rmd}}) # Add threshold if specified xfer_time_{{spAbr}} <- xfer_time_{{spAbr}}$xferTime > xfer_thresProb_{{spAbr}} ##Make map ###Make map of transfer bb_{{spAbr}} <- bgExt_{{spAbr}}@bbox bbZoom <- polyZoom(bb_{{spAbr}}[1, 1], bb_{{spAbr}}[2, 1], bb_{{spAbr}}[1, 2], bb_{{spAbr}}[2, 2], fraction = 0.05) mapXferVals_{{spAbr}} <- getRasterVals(xfer_time_{{spAbr}},"{{outputType_rmd}}") # if threshold specified rasPal_{{spAbr}} <- c('gray', 'red') m <- leaflet() %>% addProviderTiles(providers$Esri.WorldTopoMap) m %>% fitBounds(bbZoom[1], bbZoom[2], bbZoom[3], bbZoom[4]) %>% leaflet::addLegend("bottomright", colors = c('gray', 'red'), title = "Thresholded Suitability<br>(Transferred)", labels = c("predicted absence", "predicted presence"), opacity = 1, layerId = 'xfer')%>% # map model prediction raster and polygon of transfer clearMarkers() %>% clearShapes() %>% removeImage('xferRas') %>% addRasterImage(xfer_time_{{spAbr}}, colors = rasPal_{{spAbr}}, opacity = 0.7, layerId = 'xferRas', group = 'xfer', method = "ngb") %>% ##add polygon of transfer (same modeling area) addPolygons(data = bgExt_{{spAbr}}, fill = FALSE, weight = 4, color = "blue", group = 'xfer')
```{asis, echo = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & !xfer_time_threshold_knit & xfer_time_worldclim_knit}}, eval = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & !xfer_time_threshold_knit & xfer_time_worldclim_knit}}, include = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & !xfer_time_threshold_knit & xfer_time_worldclim_knit}}}
Transfer model
Transferring the model to a user drawn area with no threshold. New time based on {{envs_name_rmd}} variables for {{yearMin_rmd}} using a {{model_rmd}} GCM and an SSP of {{rcp_rmd}}.
```r}, include = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & !xfer_time_threshold_knit & xfer_time_worldclim_knit}}} #Download variables for transferring xferTimeEnvs_{{spAbr}} <- geodata::cmip6_world( model = "{{model_rmd}}", ssp = "{{rcp_rmd}}", time = "{{year_rmd}}", var = "bio", res = round((raster::res(bgMask_{{spAbr}}) * 60)[1],1), path = tempdir()) names(xferTimeEnvs_{{spAbr}}) <- paste0('bio', c(paste0('0',1:9), 10:19)) # Select variables for transferring to match variables used for modelling xferTimeEnvs_{{spAbr}} <- xferTimeEnvs_{{spAbr}}[[names(bgMask_{{spAbr}})]] # Convert to rasterstack xferTimeEnvs_{{spAbr}} <- raster::stack(xferTimeEnvs_{{spAbr}}) # Generate the area of transfer according to the drawn polygon in the GUI xfer_draw_{{spAbr}} <-xfer_draw( polyXfXY = matrix({{polyXfXY_rmd}}, ncol = 2, byrow = FALSE), polyXfID = {{polyXfID_rmd}}, drawXfBuf = {{BgBuf_rmd}}) # Generate a transfer of the model to the desired area and time xfer_time_{{spAbr}} <-xfer_time( evalOut = model_{{spAbr}}, curModel = "{{curModel_rmd}}", envs = xferTimeEnvs_{{spAbr}}, xfExt = xfer_draw_{{spAbr}}, alg = "{{alg_rmd}}", outputType = "{{outputType_rmd}}", clamp = {{clamp_rmd}} ) #store the cropped variables of transfer xferExt_{{spAbr}} <- xfer_time_{{spAbr}}$xferExt ###Make map of transfer bb_{{spAbr}} <- bgExt_{{spAbr}}@bbox bbZoom <- polyZoom(bb_{{spAbr}}[1, 1], bb_{{spAbr}}[2, 1], bb_{{spAbr}}[1, 2], bb_{{spAbr}}[2, 2], fraction = 0.05) mapXferVals_{{spAbr}} <- getRasterVals(xfer_time_{{spAbr}}$xferTime,"{{outputType_rmd}}") rasCols_{{spAbr}} <- c("#2c7bb6", "#abd9e9", "#ffffbf", "#fdae61", "#d7191c") # if no threshold specified legendPal <- colorNumeric(rev(rasCols_{{spAbr}}), mapXferVals_{{spAbr}}, na.color = 'transparent') rasPal_{{spAbr}} <- colorNumeric(rasCols_{{spAbr}}, mapXferVals_{{spAbr}}, na.color = 'transparent') m <- leaflet() %>% addProviderTiles(providers$Esri.WorldTopoMap) m %>% fitBounds(bbZoom[1], bbZoom[2], bbZoom[3], bbZoom[4]) %>% leaflet::addLegend("bottomright", pal = legendPal, title = "Predicted Suitability<br>(Transferred)", values = mapXferVals_{{spAbr}}, layerId = 'xfer', labFormat = reverseLabel(2, reverse_order = TRUE)) %>% # map model prediction raster and polygon of transfer clearMarkers() %>% clearShapes() %>% removeImage('xferRas') %>% addRasterImage(xfer_time_{{spAbr}}$xferTime, colors = rasPal_{{spAbr}}, opacity = 0.7, layerId = 'xferRas', group = 'xfer', method = "ngb") %>% ##add polygon of transfer (user drawn area) addPolygons(data = xfer_draw_{{spAbr}}, fill = FALSE, weight = 4, color = "blue", group = 'xfer')
```{asis, echo = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & xfer_time_threshold_knit & xfer_time_worldclim_knit}}, eval = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & xfer_time_threshold_knit & xfer_time_worldclim_knit}}, include = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & xfer_time_threshold_knit & xfer_time_worldclim_knit}}}
Transfer model
Transferring the model to a user drawn area with a "{{xfer_thresholdRule_rmd}}" threshold rule of {{xfer_threshold_rmd}}. New time based on {{envs_name_rmd}} variables for {{yearMin_rmd}} using a {{model_rmd}} GCM and an SSP of {{rcp_rmd}}.
```r}, include = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & xfer_time_threshold_knit & xfer_time_worldclim_knit}}} #Download variables for transferring xferTimeEnvs_{{spAbr}} <- geodata::cmip6_world( model = "{{model_rmd}}", ssp = "{{rcp_rmd}}", time = "{{year_rmd}}", var = "bio", res = round((raster::res(bgMask_{{spAbr}}) * 60)[1],1), path = tempdir()) names(xferTimeEnvs_{{spAbr}}) <- paste0('bio', c(paste0('0',1:9), 10:19)) # Select variables for transferring to match variables used for modelling xferTimeEnvs_{{spAbr}} <- xferTimeEnvs_{{spAbr}}[[names(bgMask_{{spAbr}})]] # Convert to rasterstack xferTimeEnvs_{{spAbr}} <- raster::stack(xferTimeEnvs_{{spAbr}}) # Generate the area of transfer according to the drawn polygon in the GUI xfer_draw_{{spAbr}} <-xfer_draw( polyXfXY = matrix({{polyXfXY_rmd}},ncol=2,byrow=FALSE), polyXfID = {{polyXfID_rmd}}, drawXfBuf = {{BgBuf_rmd}}) # Generate a transfer of the model to the desired area and time xfer_time_{{spAbr}} <-xfer_time( evalOut = model_{{spAbr}}, curModel = "{{curModel_rmd}}", envs = xferTimeEnvs_{{spAbr}}, xfExt = xfer_draw_{{spAbr}}, alg = "{{alg_rmd}}", outputType = "{{outputType_rmd}}", clamp = {{clamp_rmd}} ) # store the cropped variables of transfer xferExt_{{spAbr}} <- xfer_time_{{spAbr}}$xferExt # extract the suitability values for all occurrences occs_xy_{{spAbr}} <- occs_{{spAbr}}[c('longitude', 'latitude')] # determine the threshold based on the current prediction occPredVals_{{spAbr}} <- raster::extract(predSel_{{spAbr}}, occs_xy_{{spAbr}}) # Define probability of quantile based on selected threshold xfer_thresProb_{{spAbr}} <- switch("{{xfer_thresholdRule_rmd}}", "mtp" = 0, "p10" = 0.1, "qtp" = {{xfer_probQuantile_rmd}}) # Add threshold if specified xfer_time_{{spAbr}} <- xfer_time_{{spAbr}}$xferTime > xfer_thresProb_{{spAbr}} ##Make map ###Make map of transfer bb_{{spAbr}} <- bgExt_{{spAbr}}@bbox bbZoom <- polyZoom(bb_{{spAbr}}[1, 1], bb_{{spAbr}}[2, 1], bb_{{spAbr}}[1, 2], bb_{{spAbr}}[2, 2], fraction = 0.05) mapXferVals_{{spAbr}} <- getRasterVals(xfer_time_{{spAbr}},"{{outputType_rmd}}") # if threshold specified rasPal_{{spAbr}} <- c('gray', 'red') m <- leaflet() %>% addProviderTiles(providers$Esri.WorldTopoMap) m %>% fitBounds(bbZoom[1], bbZoom[2], bbZoom[3], bbZoom[4]) %>% leaflet::addLegend("bottomright", colors = c('gray', 'red'), title = "Thresholded Suitability<br>(Transferred)", labels = c("predicted absence", "predicted presence"), opacity = 1, layerId = 'xfer') %>% # map model prediction raster and polygon of transfer clearMarkers() %>% clearShapes() %>% removeImage('xferRas') %>% addRasterImage(xfer_time_{{spAbr}}, colors = rasPal_{{spAbr}}, opacity = 0.7, layerId = 'xferRas', group = 'xfer', method = "ngb") %>% ##add polygon of transfer (user drawn area) addPolygons(data = xfer_draw_{{spAbr}}, fill = FALSE, weight = 4, color = "blue", group = 'xfer')
```{asis, echo = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & xfer_time_worldclim_knit}}, eval = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & xfer_time_worldclim_knit}}, include = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & xfer_time_worldclim_knit}}}
Transfer model
Transferring the model to a user provided area area with no threshold. New time based on {{envs_name_rmd}} variables for {{yearMin_rmd}} using a {{model_rmd}} GCM and an SSP of {{rcp_rmd}}.
```r}, include = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & xfer_time_worldclim_knit}}} # Download variables for transferring xferTimeEnvs_{{spAbr}} <- geodata::cmip6_world( model = "{{model_rmd}}", ssp = "{{rcp_rmd}}", time = "{{year_rmd}}", var = "bio", res = round((raster::res(bgMask_{{spAbr}}) * 60)[1],1), path = tempdir()) names(xferTimeEnvs_{{spAbr}}) <- paste0('bio', c(paste0('0',1:9), 10:19)) # Select variables for transferring to match variables used for modelling xferTimeEnvs_{{spAbr}} <- xferTimeEnvs_{{spAbr}}[[names(bgMask_{{spAbr}})]] # Convert to rasterstack xferTimeEnvs_{{spAbr}} <- raster::stack(xferTimeEnvs_{{spAbr}}) # Generate the area of transfer based on user provided files ##User must input the path to shapefile or csv file and the file name xfer_userExt_{{spAbr}} <- xfer_userExtent( bgShp_path = "Input path here", bgShp_name = "Input file name here", userBgBuf = {{BgBuf_rmd}}) # Generate a transfer of the model to the desired area and time xfer_time_{{spAbr}} <-xfer_time( evalOut = model_{{spAbr}}, curModel = "{{curModel_rmd}}", envs = xferTimeEnvs_{{spAbr}}, xfExt = xfer_userExt_{{spAbr}}, alg = "{{alg_rmd}}", outputType = "{{outputType_rmd}}", clamp = {{clamp_rmd}} ) # store the cropped variables of transfer xferExt_{{spAbr}} <- xfer_time_{{spAbr}}$xferExt ###Make map of transfer bb_{{spAbr}} <- bgExt_{{spAbr}}@bbox bbZoom <- polyZoom(bb_{{spAbr}}[1, 1], bb_{{spAbr}}[2, 1], bb_{{spAbr}}[1, 2], bb_{{spAbr}}[2, 2], fraction = 0.05) mapXferVals_{{spAbr}} <- getRasterVals(xfer_time_{{spAbr}}$xferTime,"{{outputType_rmd}}") rasCols_{{spAbr}} <- c("#2c7bb6", "#abd9e9", "#ffffbf", "#fdae61", "#d7191c") # if no threshold specified legendPal <- colorNumeric(rev(rasCols_{{spAbr}}), mapXferVals_{{spAbr}}, na.color = 'transparent') rasPal_{{spAbr}} <- colorNumeric(rasCols_{{spAbr}}, mapXferVals_{{spAbr}}, na.color = 'transparent') m <- leaflet() %>% addProviderTiles(providers$Esri.WorldTopoMap) m %>% fitBounds(bbZoom[1], bbZoom[2], bbZoom[3], bbZoom[4]) %>% leaflet::addLegend("bottomright", pal = legendPal, title = "Predicted Suitability<br>(Transferred)", values = mapXferVals_{{spAbr}}, layerId = 'xfer', labFormat = reverseLabel(2, reverse_order = TRUE)) %>% # map model prediction raster and polygon of transfer clearMarkers() %>% clearShapes() %>% removeImage('xferRas') %>% addRasterImage(xfer_time_{{spAbr}}$xferTime, colors = rasPal_{{spAbr}}, opacity = 0.7, layerId = 'xferRas', group = 'xfer', method = "ngb") %>% ##add polygon of transfer (user provided area) addPolygons(data = xfer_userExt_{{spAbr}}, fill = FALSE, weight = 4, color = "blue", group = 'xfer')
```{asis, echo = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & xfer_time_worldclim_knit}}, eval = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & xfer_time_worldclim_knit}}, include = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & xfer_time_worldclim_knit}}}
Transfer model
Transferring the model to a user provided area with a "{{xfer_thresholdRule_rmd}}" threshold rule of {{xfer_threshold_rmd}}. New time based on {{envs_name_rmd}} variables for {{yearMin_rmd}} using a {{model_rmd}} GCM and an SSP of {{rcp_rmd}}.
```r}, include = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & xfer_time_worldclim_knit}}} # Download variables for transferring from Worldclim xferTimeEnvs_{{spAbr}} <- geodata::cmip6_world( model = "{{model_rmd}}", ssp = "{{rcp_rmd}}", time = "{{year_rmd}}", var = "bio", res = round((raster::res(bgMask_{{spAbr}}) * 60)[1],1), path = tempdir()) names(xferTimeEnvs_{{spAbr}}) <- paste0('bio', c(paste0('0',1:9), 10:19)) # Select variables for transferring to match variables used for modelling xferTimeEnvs_{{spAbr}} <- xferTimeEnvs_{{spAbr}}[[names(bgMask_{{spAbr}})]] # Convert to rasterstack xferTimeEnvs_{{spAbr}} <- raster::stack(xferTimeEnvs_{{spAbr}}) # Generate the area of transfer based on user provided files ##User must input the path to shapefile or csv file and the file name xfer_userExt_{{spAbr}} <- xfer_userExtent( bgShp_path = "Input path here", bgShp_name = "Input file name here", userBgBuf = {{BgBuf_rmd}}) # Generate a transfer of the model to the desired area and time xfer_time_{{spAbr}} <-xfer_time( evalOut = model_{{spAbr}}, curModel = "{{curModel_rmd}}", envs = xferTimeEnvs_{{spAbr}}, xfExt = xfer_userExt_{{spAbr}}, alg = "{{alg_rmd}}", outputType = "{{outputType_rmd}}", clamp = {{clamp_rmd}} ) # store the cropped variables of transfer xferExt_{{spAbr}} <- xfer_time_{{spAbr}}$xferExt # extract the suitability values for all occurrences occs_xy_{{spAbr}} <- occs_{{spAbr}}[c('longitude', 'latitude')] # determine the threshold based on the current prediction occPredVals_{{spAbr}} <- raster::extract(predSel_{{spAbr}}, occs_xy_{{spAbr}}) # Define probability of quantile based on selected threshold xfer_thresProb_{{spAbr}} <- switch("{{xfer_thresholdRule_rmd}}", "mtp" = 0, "p10" = 0.1, "qtp" = {{xfer_probQuantile_rmd}}) # Add threshold if specified xfer_time_{{spAbr}} <- xfer_time_{{spAbr}}$xferTime > xfer_thresProb_{{spAbr}} ##Make map ###Make map of transfer bb_{{spAbr}} <- bgExt_{{spAbr}}@bbox bbZoom <- polyZoom(bb_{{spAbr}}[1, 1], bb_{{spAbr}}[2, 1], bb_{{spAbr}}[1, 2], bb_{{spAbr}}[2, 2], fraction = 0.05) mapXferVals_{{spAbr}} <- getRasterVals(xfer_time_{{spAbr}},"{{outputType_rmd}}") # if threshold specified rasPal_{{spAbr}} <- c('gray', 'red') m <- leaflet() %>% addProviderTiles(providers$Esri.WorldTopoMap) m %>% fitBounds(bbZoom[1], bbZoom[2], bbZoom[3], bbZoom[4]) %>% leaflet::addLegend("bottomright", colors = c('gray', 'red'), title = "Thresholded Suitability<br>(Transferred)", labels = c("predicted absence", "predicted presence"), opacity = 1, layerId = 'xfer')%>% # map model prediction raster and polygon of transfer clearMarkers() %>% clearShapes() %>% removeImage('xferRas') %>% addRasterImage(xfer_time_{{spAbr}}, colors = rasPal_{{spAbr}}, opacity = 0.7, layerId = 'xferRas', group = 'xfer', method = "ngb") %>% ##add polygon of transfer (user provided area) addPolygons(data = xfer_userExt_{{spAbr}}, fill = FALSE, weight = 4, color = "blue", group = 'xfer')
```{asis, echo = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & !xfer_time_worldclim_knit}}, eval = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & !xfer_time_worldclim_knit}}, include = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & !xfer_time_worldclim_knit}}}
Transfer model
Transferring the model to the same modelling area with no threshold rule. New time based on "{{envs_name_rmd}}" variables for {{yearMin_rmd}} to {{yearMax_rmd}} using a "{{xfAOGCM_rmd}}" GCM and a "{{xfScenario_rmd}}" scenario.
```r}, include = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & !xfer_time_worldclim_knit}}} #Download data from ecoClimate for transferring xferTimeEnvs_{{spAbr}} <- envs_ecoClimate( "{{xfAOGCM_rmd}}", "{{xfScenario_rmd}}", as.numeric(gsub("bio", "", names(bgMask_{{spAbr}})))) # Generate a transfer of the model to the desired area and time xfer_time_{{spAbr}} <-xfer_time( evalOut = model_{{spAbr}}, curModel = "{{curModel_rmd}}", envs = xferTimeEnvs_{{spAbr}} , xfExt = bgExt_{{spAbr}}, alg = "{{alg_rmd}}", outputType = "{{outputType_rmd}}", clamp = {{clamp_rmd}} ) #store the cropped variables of transfer xferExt_{{spAbr}} <- xfer_time_{{spAbr}}$xferExt ###Make map of transfer bb_{{spAbr}} <- bgExt_{{spAbr}}@bbox bbZoom <- polyZoom(bb_{{spAbr}}[1, 1], bb_{{spAbr}}[2, 1], bb_{{spAbr}}[1, 2], bb_{{spAbr}}[2, 2], fraction = 0.05) mapXferVals_{{spAbr}} <- getRasterVals(xfer_time_{{spAbr}}$xferTime,"{{outputType_rmd}}") rasCols_{{spAbr}} <- c("#2c7bb6", "#abd9e9", "#ffffbf", "#fdae61", "#d7191c") # if no threshold specified legendPal <- colorNumeric(rev(rasCols_{{spAbr}}), mapXferVals_{{spAbr}}, na.color = 'transparent') rasPal_{{spAbr}} <- colorNumeric(rasCols_{{spAbr}}, mapXferVals_{{spAbr}}, na.color = 'transparent') m <- leaflet() %>% addProviderTiles(providers$Esri.WorldTopoMap) m %>% fitBounds(bbZoom[1], bbZoom[2], bbZoom[3], bbZoom[4]) %>% leaflet::addLegend("bottomright", pal = legendPal, title = "Predicted Suitability<br>(Transferred)", values = mapXferVals_{{spAbr}}, layerId = 'xfer', labFormat = reverseLabel(2, reverse_order = TRUE)) %>% # map model prediction raster and polygon of transfer clearMarkers() %>% clearShapes() %>% removeImage('xferRas') %>% addRasterImage(xfer_time_{{spAbr}}$xferTime, colors = rasPal_{{spAbr}}, opacity = 0.7, layerId = 'xferRas', group = 'xfer', method = "ngb") %>% ##add polygon of transfer (same modeling area) addPolygons(data = bgExt_{{spAbr}}, fill = FALSE, weight = 4, color = "blue", group = 'xfer')
```{asis, echo = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & !xfer_time_worldclim_knit}}, eval = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & !xfer_time_worldclim_knit}}, include = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & !xfer_time_worldclim_knit}}}
Transfer model
Transferring the model to the same modelling area with a "{{xfer_thresholdRule_rmd}}" threshold rule of {{xfer_threshold_rmd}}. New time based on "{{envs_name_rmd}}" variables for {{yearMin_rmd}} to {{yearMax_rmd}} using a "{{xfAOGCM_rmd}}" GCM and a "{{xfScenario_rmd}}" scenario.
```r}, include = {{xfer_time_knit & !xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & !xfer_time_worldclim_knit}}} #Download data from ecoClimate for transferring xferTimeEnvs_{{spAbr}} <- envs_ecoClimate( "{{xfAOGCM_rmd}}", "{{xfScenario_rmd}}", as.numeric(gsub("bio", "", names(bgMask_{{spAbr}})))) # Generate a transfer of the model to the desired area and time xfer_time_{{spAbr}} <-xfer_time( evalOut = model_{{spAbr}}, curModel = "{{curModel_rmd}}", envs = xferTimeEnvs_{{spAbr}} , xfExt = bgExt_{{spAbr}}, alg = "{{alg_rmd}}", outputType = "{{outputType_rmd}}", clamp = {{clamp_rmd}} ) # store the cropped variables of transfer xferExt_{{spAbr}} <- xfer_time_{{spAbr}}$xferExt # extract the suitability values for all occurrences occs_xy_{{spAbr}} <- occs_{{spAbr}}[c('longitude', 'latitude')] # determine the threshold based on the current prediction occPredVals_{{spAbr}} <- raster::extract(predSel_{{spAbr}}, occs_xy_{{spAbr}}) # Define probability of quantile based on selected threshold xfer_thresProb_{{spAbr}} <- switch("{{xfer_thresholdRule_rmd}}", "mtp" = 0, "p10" = 0.1, "qtp" = {{xfer_probQuantile_rmd}}) # Add threshold if specified xfer_time_{{spAbr}} <- xfer_time_{{spAbr}}$xferTime > xfer_thresProb_{{spAbr}} ##Make map ###Make map of transfer bb_{{spAbr}} <- bgExt_{{spAbr}}@bbox bbZoom <- polyZoom(bb_{{spAbr}}[1, 1], bb_{{spAbr}}[2, 1], bb_{{spAbr}}[1, 2], bb_{{spAbr}}[2, 2], fraction = 0.05) mapXferVals_{{spAbr}} <- getRasterVals(xfer_time_{{spAbr}},"{{outputType_rmd}}") # if threshold specified rasPal_{{spAbr}} <- c('gray', 'red') m <- leaflet() %>% addProviderTiles(providers$Esri.WorldTopoMap) m %>% fitBounds(bbZoom[1], bbZoom[2], bbZoom[3], bbZoom[4]) %>% leaflet::addLegend("bottomright", colors = c('gray', 'red'), title = "Thresholded Suitability<br>(Transferred)", labels = c("predicted absence", "predicted presence"), opacity = 1, layerId = 'xfer') %>% # map model prediction raster and polygon of transfer clearMarkers() %>% clearShapes() %>% removeImage('xferRas') %>% addRasterImage(xfer_time_{{spAbr}}, colors = rasPal_{{spAbr}}, opacity = 0.7, layerId = 'xferRas', group = 'xfer', method = "ngb") %>% ##add polygon of transfer (same modeling area) addPolygons(data = bgExt_{{spAbr}}, fill = FALSE, weight = 4, color = "blue", group = 'xfer')
```{asis, echo = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & !xfer_time_threshold_knit & !xfer_time_worldclim_knit}}, eval = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & !xfer_time_threshold_knit & !xfer_time_worldclim_knit}}, include = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & !xfer_time_threshold_knit & !xfer_time_worldclim_knit}}}
Transfer model
Transferring the model to a user drawn area with no threshold rule. New time based on "{{envs_name_rmd}}" variables for {{yearMin_rmd}} to {{yearMax_rmd}} using a "{{xfAOGCM_rmd}}" GCM and a "{{xfScenario_rmd}}" scenario.
```r}, include = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & !xfer_time_threshold_knit & !xfer_time_worldclim_knit}}} #Download data from ecoClimate for transferring xferTimeEnvs_{{spAbr}} <- envs_ecoClimate( "{{xfAOGCM_rmd}}", "{{xfScenario_rmd}}", as.numeric(gsub("bio", "", names(bgMask_{{spAbr}})))) # Generate the area of transfer according to the drawn polygon in the GUI xfer_draw_{{spAbr}} <-xfer_draw( polyXfXY = matrix({{polyXfXY_rmd}},ncol=2,byrow=FALSE), polyXfID = {{polyXfID_rmd}}, drawXfBuf = {{BgBuf_rmd}}) # Generate a transfer of the model to the desired area and time xfer_time_{{spAbr}} <-xfer_time( evalOut = model_{{spAbr}}, curModel = "{{curModel_rmd}}", envs = xferTimeEnvs_{{spAbr}}, xfExt = xfer_draw_{{spAbr}}, alg = "{{alg_rmd}}", outputType = "{{outputType_rmd}}", clamp = {{clamp_rmd}} ) # Store the cropped variables of transfer xferExt_{{spAbr}} <- xfer_time_{{spAbr}}$xferExt ###Make map of transfer bb_{{spAbr}} <- bgExt_{{spAbr}}@bbox bbZoom <- polyZoom(bb_{{spAbr}}[1, 1], bb_{{spAbr}}[2, 1], bb_{{spAbr}}[1, 2], bb_{{spAbr}}[2, 2], fraction = 0.05) mapXferVals_{{spAbr}} <- getRasterVals(xfer_time_{{spAbr}}$xferTime,"{{outputType_rmd}}") rasCols_{{spAbr}} <- c("#2c7bb6", "#abd9e9", "#ffffbf", "#fdae61", "#d7191c") # if no threshold specified legendPal <- colorNumeric(rev(rasCols_{{spAbr}}), mapXferVals_{{spAbr}}, na.color = 'transparent') rasPal_{{spAbr}} <- colorNumeric(rasCols_{{spAbr}}, mapXferVals_{{spAbr}}, na.color = 'transparent') m <- leaflet() %>% addProviderTiles(providers$Esri.WorldTopoMap) m %>% fitBounds(bbZoom[1], bbZoom[2], bbZoom[3], bbZoom[4]) %>% leaflet::addLegend("bottomright", pal = legendPal, title = "Predicted Suitability<br>(Transferred)", values = mapXferVals_{{spAbr}}, layerId = 'xfer', labFormat = reverseLabel(2, reverse_order = TRUE)) %>% # map model prediction raster and polygon of transfer clearMarkers() %>% clearShapes() %>% removeImage('xferRas') %>% addRasterImage(xfer_time_{{spAbr}}$xferTime, colors = rasPal_{{spAbr}}, opacity = 0.7, layerId = 'xferRas', group = 'xfer', method = "ngb") %>% ##add polygon of transfer (user drawn area) addPolygons(data = xfer_draw_{{spAbr}}, fill = FALSE, weight = 4, color = "blue", group = 'xfer')
```{asis, echo = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & xfer_time_threshold_knit & !xfer_time_worldclim_knit}}, eval = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & xfer_time_threshold_knit & !xfer_time_worldclim_knit}}, include = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & xfer_time_threshold_knit & !xfer_time_worldclim_knit}}}
Transfer model
Transferring the model to a user drawn area with a "{{xfer_thresholdRule_rmd}}" threshold rule of {{xfer_threshold_rmd}}. New time based on "{{envs_name_rmd}}" variables for {{yearMin_rmd}} to {{yearMax_rmd}} using a "{{xfAOGCM_rmd}}" GCM and a "{{xfScenario_rmd}}" scenario.
```r}, include = {{xfer_time_knit & !xfer_time_user_knit & xfer_time_drawn_knit & xfer_time_threshold_knit & !xfer_time_worldclim_knit}}} #Download data from ecoClimate for transferring xferTimeEnvs_{{spAbr}} <- envs_ecoClimate( "{{xfAOGCM_rmd}}", "{{xfScenario_rmd}}", as.numeric(gsub("bio", "", names(bgMask_{{spAbr}})))) # Generate the area of transfer according to the drawn polygon in the GUI xfer_draw_{{spAbr}} <-xfer_draw( polyXfXY = matrix({{polyXfXY_rmd}},ncol=2,byrow=FALSE), polyXfID = {{polyXfID_rmd}}, drawXfBuf = {{BgBuf_rmd}}) # Generate a transfer of the model to the desired area and time xfer_time_{{spAbr}} <-xfer_time( evalOut = model_{{spAbr}}, curModel = "{{curModel_rmd}}", envs = xferTimeEnvs_{{spAbr}}, xfExt = xfer_draw_{{spAbr}}, alg = "{{alg_rmd}}", outputType = "{{outputType_rmd}}", clamp = {{clamp_rmd}} ) # store the cropped variables of transfer xferExt_{{spAbr}} <- xfer_time_{{spAbr}}$xferExt # extract the suitability values for all occurrences occs_xy_{{spAbr}} <- occs_{{spAbr}}[c('longitude', 'latitude')] # determine the threshold based on the current prediction occPredVals_{{spAbr}} <- raster::extract(predSel_{{spAbr}}, occs_xy_{{spAbr}}) # Define probability of quantile based on selected threshold xfer_thresProb_{{spAbr}} <- switch("{{xfer_thresholdRule_rmd}}", "mtp" = 0, "p10" = 0.1, "qtp" = {{xfer_probQuantile_rmd}}) # Add threshold if specified xfer_time_{{spAbr}} <- xfer_time_{{spAbr}}$xferTime > xfer_thresProb_{{spAbr}} ##Make map ###Make map of transfer bb_{{spAbr}} <- bgExt_{{spAbr}}@bbox bbZoom <- polyZoom(bb_{{spAbr}}[1, 1], bb_{{spAbr}}[2, 1], bb_{{spAbr}}[1, 2], bb_{{spAbr}}[2, 2], fraction = 0.05) mapXferVals_{{spAbr}} <- getRasterVals(xfer_time_{{spAbr}},"{{outputType_rmd}}") # if threshold specified rasPal_{{spAbr}} <- c('gray', 'red') m <- leaflet() %>% addProviderTiles(providers$Esri.WorldTopoMap) m %>% fitBounds(bbZoom[1], bbZoom[2], bbZoom[3], bbZoom[4]) %>% leaflet::addLegend("bottomright", colors = c('gray', 'red'), title = "Thresholded Suitability<br>(Transferred)", labels = c("predicted absence", "predicted presence"), opacity = 1, layerId = 'xfer')%>% # map model prediction raster and polygon of transfer clearMarkers() %>% clearShapes() %>% removeImage('xferRas') %>% addRasterImage(xfer_time_{{spAbr}}, colors = rasPal_{{spAbr}}, opacity = 0.7, layerId = 'xferRas', group = 'xfer', method = "ngb") %>% ##add polygon of transfer (user drawn area) addPolygons(data = xfer_draw_{{spAbr}}, fill = FALSE, weight = 4, color = "blue", group = 'xfer')
```{asis, echo = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & !xfer_time_worldclim_knit}}, eval = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & !xfer_time_worldclim_knit}}, include = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & !xfer_time_worldclim_knit}}}
Transfer model
Transferring the model to a user provided area with no threshold rule. New time based on "{{envs_name_rmd}}" variables for {{yearMin_rmd}} to {{yearMax_rmd}} using a "{{xfAOGCM_rmd}}" GCM and a "{{xfScenario_rmd}}" scenario.
```r}, include = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & !xfer_time_threshold_knit & !xfer_time_worldclim_knit}}} #Download data from ecoClimate for transferring xferTimeEnvs_{{spAbr}} <- envs_ecoClimate( "{{xfAOGCM_rmd}}", "{{xfScenario_rmd}}", as.numeric(gsub("bio", "", names(bgMask_{{spAbr}})))) # Generate the area of transfer based on user provided files ##User must input the path to shapefile or csv file and the file name xfer_userExt_{{spAbr}} <- xfer_userExtent( bgShp_path = "Input path here", bgShp_name = "Input file name here", userBgBuf = {{BgBuf_rmd}}) # Generate a transfer of the model to the desired area and time xfer_time_{{spAbr}} <-xfer_time( evalOut = model_{{spAbr}}, curModel = "{{curModel_rmd}}", envs = xferTimeEnvs_{{spAbr}}, xfExt = xfer_userExt_{{spAbr}}, alg = "{{alg_rmd}}", outputType = "{{outputType_rmd}}", clamp = {{clamp_rmd}} ) # store the cropped variables of transfer xferExt_{{spAbr}} <- xfer_time_{{spAbr}}$xferExt ###Make map of transfer bb_{{spAbr}} <- bgExt_{{spAbr}}@bbox bbZoom <- polyZoom(bb_{{spAbr}}[1, 1], bb_{{spAbr}}[2, 1], bb_{{spAbr}}[1, 2], bb_{{spAbr}}[2, 2], fraction = 0.05) mapXferVals_{{spAbr}} <- getRasterVals(xfer_time_{{spAbr}}$xferTime,"{{outputType_rmd}}") rasCols_{{spAbr}} <- c("#2c7bb6", "#abd9e9", "#ffffbf", "#fdae61", "#d7191c") # if no threshold specified legendPal <- colorNumeric(rev(rasCols_{{spAbr}}), mapXferVals_{{spAbr}}, na.color = 'transparent') rasPal_{{spAbr}} <- colorNumeric(rasCols_{{spAbr}}, mapXferVals_{{spAbr}}, na.color = 'transparent') m <- leaflet() %>% addProviderTiles(providers$Esri.WorldTopoMap) m %>% fitBounds(bbZoom[1], bbZoom[2], bbZoom[3], bbZoom[4]) %>% leaflet::addLegend("bottomright", pal = legendPal, title = "Predicted Suitability<br>(Transferred)", values = mapXferVals_{{spAbr}}, layerId = 'xfer', labFormat = reverseLabel(2, reverse_order = TRUE)) %>% # map model prediction raster and polygon of transfer clearMarkers() %>% clearShapes() %>% removeImage('xferRas') %>% addRasterImage(xfer_time_{{spAbr}}$xferTime, colors = rasPal_{{spAbr}}, opacity = 0.7, layerId = 'xferRas', group = 'xfer', method = "ngb") %>% ##add polygon of transfer (user provided area) addPolygons(data = xfer_userExt_{{spAbr}}, fill = FALSE, weight = 4, color = "blue", group = 'xfer')
```{asis, echo = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & !xfer_time_worldclim_knit}}, eval = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & !xfer_time_worldclim_knit}}, include = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & !xfer_time_worldclim_knit}}}
Transfer model
Transferring the model to a user provided area with a "{{xfer_thresholdRule_rmd}}" threshold rule of {{xfer_threshold_rmd}}. New time based on "{{envs_name_rmd}}" variables for {{yearMin_rmd}} to {{yearMax_rmd}} using a "{{xfAOGCM_rmd}}" GCM and a "{{xfScenario_rmd}}" scenario.
```r}, include = {{xfer_time_knit & xfer_time_user_knit & !xfer_time_drawn_knit & xfer_time_threshold_knit & !xfer_time_worldclim_knit}}} #Download data from ecoClimate for transferring xferTimeEnvs_{{spAbr}} <- envs_ecoClimate( "{{xfAOGCM_rmd}}", "{{xfScenario_rmd}}", as.numeric(gsub("bio", "", names(bgMask_{{spAbr}})))) # Generate the area of transfer based on user provided files ##User must input the path to shapefile or csv file and the file name xfer_userExt_{{spAbr}} <- xfer_userExtent( bgShp_path = "Input path here", bgShp_name = "Input file name here", userBgBuf = {{BgBuf_rmd}}) # Generate a transfer of the model to the desired area and time xfer_time_{{spAbr}} <-xfer_time( evalOut = model_{{spAbr}}, curModel = "{{curModel_rmd}}", envs = xferTimeEnvs_{{spAbr}}, xfExt = xfer_userExt_{{spAbr}}, alg = "{{alg_rmd}}", outputType = "{{outputType_rmd}}", clamp = {{clamp_rmd}} ) # store the cropped variables of transfer xferExt_{{spAbr}} <- xfer_time_{{spAbr}}$xferExt # extract the suitability values for all occurrences occs_xy_{{spAbr}} <- occs_{{spAbr}}[c('longitude', 'latitude')] # determine the threshold based on the current prediction occPredVals_{{spAbr}} <- raster::extract(predSel_{{spAbr}}, occs_xy_{{spAbr}}) # Define probability of quantile based on selected threshold xfer_thresProb_{{spAbr}} <- switch("{{xfer_thresholdRule_rmd}}", "mtp" = 0, "p10" = 0.1, "qtp" = {{xfer_probQuantile_rmd}}) # Add threshold if specified xfer_time_{{spAbr}} <- xfer_time_{{spAbr}}$xferTime > xfer_thresProb_{{spAbr}} ##Make map ###Make map of transfer bb_{{spAbr}} <- bgExt_{{spAbr}}@bbox bbZoom <- polyZoom(bb_{{spAbr}}[1, 1], bb_{{spAbr}}[2, 1], bb_{{spAbr}}[1, 2], bb_{{spAbr}}[2, 2], fraction = 0.05) mapXferVals_{{spAbr}} <- getRasterVals(xfer_time_{{spAbr}},"{{outputType_rmd}}") # if threshold specified rasPal_{{spAbr}} <- c('gray', 'red') m <- leaflet() %>% addProviderTiles(providers$Esri.WorldTopoMap) m %>% fitBounds(bbZoom[1], bbZoom[2], bbZoom[3], bbZoom[4]) %>% leaflet::addLegend("bottomright", colors = c('gray', 'red'), title = "Thresholded Suitability<br>(Transferred)", labels = c("predicted absence", "predicted presence"), opacity = 1, layerId = 'xfer')%>% # map model prediction raster and polygon of transfer clearMarkers() %>% clearShapes() %>% removeImage('xferRas') %>% addRasterImage(xfer_time_{{spAbr}}, colors = rasPal_{{spAbr}}, opacity = 0.7, layerId = 'xferRas', group = 'xfer', method = "ngb") %>% ##add polygon of transfer (user provided area) addPolygons(data = xfer_userExt_{{spAbr}}, fill = FALSE, weight = 4, color = "blue", group = 'xfer')
Try the wallace package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.