Introduction

Install Packages

if (!require("rspat")) remotes::install_github("rspatial/rspat") ###Loading required package: rspat ###Loading required package: terra ###terra 1.7.62 
if (!require("predicts")) install.packages("predicts") ###Loading required package: predicts 
if (!require("geodata")) install.packages("geodata") ###Loading required package: geodata 

call terra and rspat package

library(terra) 
library(rspat) 
bf <- spat_data("bigfoot") 

Observation

dim(bf) 
[1] 3092    3
head(bf) 
  • Purpose: Checks data dimensions and previews data.
  • Output Use: Understand the structure of your dataset. ### Plot
plot(bf[,1:2], cex=0.5, col="red") 
library(geodata) 
wrld <- geodata::world(path=".") 
bnds <- wrld[wrld$NAME_0 %in% 
               c("Canada", "Mexico", "United States"), ] 
lines(bnds) 

Purpose: Plots species occurrence points. Output Use: Visualizes spatial distribution.

Visualization

wc <- geodata::worldclim_global("bio", res=10, ".") 
plot(wc[[c(1, 12)]], nr=2) 

climate data

bfc <- extract(wc, bf[,1:2]) 
head(bfc, 3) 

remove the first column with the ID

bfc <- bfc[,-1] 

plot the species’ distribution

plot(bfc[ ,"wc2.1_10m_bio_1"], bfc[, "wc2.1_10m_bio_12"], col="red", xlab="Annual mean temperature (.C)", ylab="Annual precipitation (mm)") 

Background data

ext_bf <- ext(vect(bf[, 1:2])) + 1 
ext_bf 
SpatExtent : -157.75, -63.4627, 24.141, 70.5 (xmin, xmax, ymin, ymax)

take 5000 random samples

set.seed(0) 
window(wc) <- ext_bf 
bg <- spatSample(wc, 5000, "random", na.rm=TRUE, xy=TRUE) 
head(bg) 

Plot spatSample

plot(bg[, c("x", "y")]) 

Data

bg <- bg[, -c(1:2)] 

Plot Data

plot(bg[,1], bg[,12], xlab="Annual mean temperature (∞C)", ylab="Annual precipitation (mm)", cex=.8) 
points(bfc[,1], bfc[,12], col="red", cex=.6, pch="+") 
legend("topleft", c("observed", "background"), col=c("red", "black"), pch=c("+", "o"),pt.cex=c(.6, .8)) 

East vs West

#eastern points 
bfe <- bfc[bf[,1] > -102, ] 
#western points 
bfw <- bfc[bf[,1] <= -102, ] 
dw <- rbind(cbind(pa=1, bfw), cbind(pa=0, bg)) 
de <- rbind(cbind(pa=1, bfe), cbind(pa=0, bg)) 
dw <- data.frame(dw) 
de <- data.frame(na.omit(de)) 
dim(dw) ###[1] 6224 20 
[1] 6224   20
dim(de) ###[1] 6866 20 
[1] 6866   20

Fit a model

CART

library(rpart) 
cart <- rpart(pa~., data=dw) 

complexity paramete

printcp(cart) 

Regression tree:
rpart(formula = pa ~ ., data = dw)

Variables actually used in tree construction:
[1] wc2.1_10m_bio_10 wc2.1_10m_bio_12 wc2.1_10m_bio_14 wc2.1_10m_bio_18 wc2.1_10m_bio_19 wc2.1_10m_bio_3 
[7] wc2.1_10m_bio_4 

Root node error: 983.29/6224 = 0.15798

n= 6224 

        CP nsplit rel error  xerror     xstd
1 0.322797      0   1.00000 1.00019 0.019351
2 0.080521      1   0.67720 0.68771 0.019687
3 0.073325      2   0.59668 0.59759 0.015480
4 0.068645      3   0.52336 0.52163 0.015231
5 0.027920      4   0.45471 0.47026 0.014758
6 0.014907      5   0.42679 0.44778 0.015136
7 0.010869      6   0.41188 0.44082 0.015406
8 0.010197      7   0.40102 0.43500 0.015330
9 0.010000      8   0.39082 0.43197 0.015319

plot

plotcp(cart) 

Fit the model

cart <- rpart(pa~., data=dw, cp=0.02) 

plot

library(rpart.plot) 
rpart.plot(cart, uniform=TRUE, main="Regression Tree") 

use the model to show how attractive the climate is for this species

x <- predict(wc, cart) 
x <- mask(x, wc[[1]]) 
x <- round(x, 2) 
plot(x, type="class", plg=list(x="bottomleft")) 

Random Forest

Test and Train Data

set.seed(123) 
i <- sample(nrow(dw), 0.2 * nrow(dw)) 
test <- dw[i,] 
train <- dw[-i,] 
fpa <- as.factor(train[, 'pa']) 

RandomForest model

library(randomForest) ###randomForest 4.7-1.1 ###Type rfNews() to see new features/changes/bug fixes. 
crf <- randomForest(train[, 2:ncol(train)], fpa) 
crf

Call:
 randomForest(x = train[, 2:ncol(train)], y = fpa) 
               Type of random forest: classification
                     Number of trees: 500
No. of variables tried at each split: 4

        OOB estimate of  error rate: 7.19%
Confusion matrix:
     0   1 class.error
0 3832 165  0.04128096
1  193 790  0.19633774

variable importance plot

varImpPlot(crf) 

use regression ( tune a parameter )

trf <- tuneRF(train[, 2:ncol(train)], train[, "pa"]) 
Warning: The response has five or fewer unique values.  Are you sure you want to do regression?
mtry = 6  OOB error = 0.05594974 
Searching left ...
Warning: The response has five or fewer unique values.  Are you sure you want to do regression?
mtry = 3    OOB error = 0.05612125 
-0.003065481 0.05 
Searching right ...
Warning: The response has five or fewer unique values.  Are you sure you want to do regression?
mtry = 12   OOB error = 0.05485775 
0.01951734 0.05 

trf 
   mtry   OOBError
3     3 0.05612125
6     6 0.05594974
12   12 0.05485775
mt <- trf[which.min(trf[,2]), 1] 
mt 
[1] 12

tuneRF and values of mt represen

rrf <- randomForest(train[, 2:ncol(train)], train[, "pa"], mtry=mt, ntree=250) 
Warning: The response has five or fewer unique values.  Are you sure you want to do regression?
plot(rrf) 

Predict

Regression

rp <- predict(wc, rrf, na.rm=TRUE)
plot(rp) 

optimal threshold

library(predicts) 
eva <- pa_evaluate(predict(rrf, test[test$pa==1, ]), predict(rrf, test[test$pa==0, ])) 
eva 
@stats

@thresholds

@tr_stats

ROC

plot(eva, "ROC") 

Box plot and predictive value

par(mfrow=c(1,2)) 
plot(eva, "boxplot") 
plot(eva, "density") 

use the “max specificity + sensitivity” threshold

tr <- eva@thresholds 
tr ## max_kappa max_spec_sens no_omission equal_prevalence equal_sens_spec 
## 1 0.4469667 0.3219856 0.00425973 0.1952333 0.2167239
plot(rp > tr$max_spec_sens) 

Classification

classification Random Forest model

rc <- predict(wc, crf, na.rm=TRUE) 
plot(rc) 

Add probability

rc2 <- predict(wc, crf, type="prob", na.rm=TRUE) 
plot(rc2, 2) 

Extrapolation

Distribution of the Eastern species

Plot

our model is really good in predicting the range of the West, but it cannot extrapolate at all to the East.

World Map

window(wc) <- NULL 
pm <- predict(wc, rrf, na.rm=TRUE) 
plot(pm) 
lines(wrld) 

estimate range shifts due to climate change

fut <- cmip6_world("CNRM-CM6-1", "585", "2061-2080", var="bio", res=10, path=".") 
names(fut)
 [1] "bio01" "bio02" "bio03" "bio04" "bio05" "bio06" "bio07" "bio08" "bio09" "bio10" "bio11" "bio12" "bio13"
[14] "bio14" "bio15" "bio16" "bio17" "bio18" "bio19"
names(fut) <- names(wc) 
window(fut) <- ext_bf 
pfut <- predict(fut, rrf, na.rm=TRUE) 
plot(pfut) 

LS0tDQp0aXRsZTogIlNQQVRJQUwgRElTVFJJQlVUSU9OIE1PREVMUyAiDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KIyMgSW50cm9kdWN0aW9uDQojIyMgSW5zdGFsbCBQYWNrYWdlcw0KYGBge3J9DQppZiAoIXJlcXVpcmUoInJzcGF0IikpIHJlbW90ZXM6Omluc3RhbGxfZ2l0aHViKCJyc3BhdGlhbC9yc3BhdCIpICMjI0xvYWRpbmcgcmVxdWlyZWQgcGFja2FnZTogcnNwYXQgIyMjTG9hZGluZyByZXF1aXJlZCBwYWNrYWdlOiB0ZXJyYSAjIyN0ZXJyYSAxLjcuNjIgDQppZiAoIXJlcXVpcmUoInByZWRpY3RzIikpIGluc3RhbGwucGFja2FnZXMoInByZWRpY3RzIikgIyMjTG9hZGluZyByZXF1aXJlZCBwYWNrYWdlOiBwcmVkaWN0cyANCmlmICghcmVxdWlyZSgiZ2VvZGF0YSIpKSBpbnN0YWxsLnBhY2thZ2VzKCJnZW9kYXRhIikgIyMjTG9hZGluZyByZXF1aXJlZCBwYWNrYWdlOiBnZW9kYXRhIA0KYGBgDQojIyMgY2FsbCB0ZXJyYSBhbmQgcnNwYXQgcGFja2FnZQ0KYGBge3J9DQpsaWJyYXJ5KHRlcnJhKSANCmxpYnJhcnkocnNwYXQpIA0KYmYgPC0gc3BhdF9kYXRhKCJiaWdmb290IikgDQpgYGANCiMjIyBPYnNlcnZhdGlvbg0KYGBge3J9DQpkaW0oYmYpIA0KaGVhZChiZikgDQpgYGANCi0gUHVycG9zZTogQ2hlY2tzIGRhdGEgZGltZW5zaW9ucyBhbmQgcHJldmlld3MgZGF0YS4NCi0gT3V0cHV0IFVzZTogVW5kZXJzdGFuZCB0aGUgc3RydWN0dXJlIG9mIHlvdXIgZGF0YXNldC4NCiMjIyBQbG90DQpgYGB7cn0NCnBsb3QoYmZbLDE6Ml0sIGNleD0wLjUsIGNvbD0icmVkIikgDQpsaWJyYXJ5KGdlb2RhdGEpIA0Kd3JsZCA8LSBnZW9kYXRhOjp3b3JsZChwYXRoPSIuIikgDQpibmRzIDwtIHdybGRbd3JsZCROQU1FXzAgJWluJSANCiAgICAgICAgICAgICAgIGMoIkNhbmFkYSIsICJNZXhpY28iLCAiVW5pdGVkIFN0YXRlcyIpLCBdIA0KbGluZXMoYm5kcykgDQpgYGANClB1cnBvc2U6IFBsb3RzIHNwZWNpZXMgb2NjdXJyZW5jZSBwb2ludHMuDQpPdXRwdXQgVXNlOiBWaXN1YWxpemVzIHNwYXRpYWwgZGlzdHJpYnV0aW9uLg0KDQojIyBWaXN1YWxpemF0aW9uDQpgYGB7cn0NCndjIDwtIGdlb2RhdGE6OndvcmxkY2xpbV9nbG9iYWwoImJpbyIsIHJlcz0xMCwgIi4iKSANCnBsb3Qod2NbW2MoMSwgMTIpXV0sIG5yPTIpIA0KYGBgDQojIyMgY2xpbWF0ZSBkYXRhDQpgYGB7cn0NCmJmYyA8LSBleHRyYWN0KHdjLCBiZlssMToyXSkgDQpoZWFkKGJmYywgMykgDQpgYGANCiMjIyByZW1vdmUgdGhlIGZpcnN0IGNvbHVtbiB3aXRoIHRoZSBJRA0KYGBge3J9DQpiZmMgPC0gYmZjWywtMV0gDQpgYGANCiMjIyBwbG90IHRoZSBzcGVjaWVz4oCZIGRpc3RyaWJ1dGlvbiANCmBgYHtyfQ0KcGxvdChiZmNbICwid2MyLjFfMTBtX2Jpb18xIl0sIGJmY1ssICJ3YzIuMV8xMG1fYmlvXzEyIl0sIGNvbD0icmVkIiwgeGxhYj0iQW5udWFsIG1lYW4gdGVtcGVyYXR1cmUgKC5DKSIsIHlsYWI9IkFubnVhbCBwcmVjaXBpdGF0aW9uIChtbSkiKSANCmBgYA0KIyMjIEJhY2tncm91bmQgZGF0YSANCmBgYHtyfQ0KZXh0X2JmIDwtIGV4dCh2ZWN0KGJmWywgMToyXSkpICsgMSANCmV4dF9iZiANCmBgYA0KIyMjIHRha2UgNTAwMCByYW5kb20gc2FtcGxlcw0KYGBge3J9DQpzZXQuc2VlZCgwKSANCndpbmRvdyh3YykgPC0gZXh0X2JmIA0KYmcgPC0gc3BhdFNhbXBsZSh3YywgNTAwMCwgInJhbmRvbSIsIG5hLnJtPVRSVUUsIHh5PVRSVUUpIA0KaGVhZChiZykgDQpgYGANCg0KIyMjIFBsb3Qgc3BhdFNhbXBsZQ0KYGBge3J9DQpwbG90KGJnWywgYygieCIsICJ5IildKSANCmBgYA0KIyMgRGF0YQ0KYGBge3J9DQpiZyA8LSBiZ1ssIC1jKDE6MildIA0KYGBgDQojIyMgUGxvdCBEYXRhDQpgYGB7cn0NCnBsb3QoYmdbLDFdLCBiZ1ssMTJdLCB4bGFiPSJBbm51YWwgbWVhbiB0ZW1wZXJhdHVyZSAo4oieQykiLCB5bGFiPSJBbm51YWwgcHJlY2lwaXRhdGlvbiAobW0pIiwgY2V4PS44KSANCnBvaW50cyhiZmNbLDFdLCBiZmNbLDEyXSwgY29sPSJyZWQiLCBjZXg9LjYsIHBjaD0iKyIpIA0KbGVnZW5kKCJ0b3BsZWZ0IiwgYygib2JzZXJ2ZWQiLCAiYmFja2dyb3VuZCIpLCBjb2w9YygicmVkIiwgImJsYWNrIiksIHBjaD1jKCIrIiwgIm8iKSxwdC5jZXg9YyguNiwgLjgpKSANCmBgYA0KIyMjIEVhc3QgdnMgV2VzdCANCmBgYHtyfQ0KI2Vhc3Rlcm4gcG9pbnRzIA0KYmZlIDwtIGJmY1tiZlssMV0gPiAtMTAyLCBdIA0KI3dlc3Rlcm4gcG9pbnRzIA0KYmZ3IDwtIGJmY1tiZlssMV0gPD0gLTEwMiwgXSANCmR3IDwtIHJiaW5kKGNiaW5kKHBhPTEsIGJmdyksIGNiaW5kKHBhPTAsIGJnKSkgDQpkZSA8LSByYmluZChjYmluZChwYT0xLCBiZmUpLCBjYmluZChwYT0wLCBiZykpIA0KZHcgPC0gZGF0YS5mcmFtZShkdykgDQpkZSA8LSBkYXRhLmZyYW1lKG5hLm9taXQoZGUpKSANCmRpbShkdykgIyMjWzFdIDYyMjQgMjAgDQpkaW0oZGUpICMjI1sxXSA2ODY2IDIwIA0KYGBgDQojIyBGaXQgYSBtb2RlbCANCiMjIENBUlQgDQpgYGB7cn0NCmxpYnJhcnkocnBhcnQpIA0KY2FydCA8LSBycGFydChwYX4uLCBkYXRhPWR3KSANCmBgYA0KIyMjIGNvbXBsZXhpdHkgcGFyYW1ldGUNCmBgYHtyfQ0KcHJpbnRjcChjYXJ0KSANCmBgYA0KIyMjIHBsb3QNCmBgYHtyfQ0KcGxvdGNwKGNhcnQpIA0KYGBgDQojIyMgRml0IHRoZSBtb2RlbA0KYGBge3J9DQpjYXJ0IDwtIHJwYXJ0KHBhfi4sIGRhdGE9ZHcsIGNwPTAuMDIpIA0KYGBgDQojIyMgcGxvdA0KYGBge3J9DQpsaWJyYXJ5KHJwYXJ0LnBsb3QpIA0KcnBhcnQucGxvdChjYXJ0LCB1bmlmb3JtPVRSVUUsIG1haW49IlJlZ3Jlc3Npb24gVHJlZSIpIA0KYGBgDQojIyMgdXNlIHRoZSBtb2RlbCB0byBzaG93IGhvdyBhdHRyYWN0aXZlIHRoZSBjbGltYXRlIGlzIGZvciB0aGlzIHNwZWNpZXMNCmBgYHtyfQ0KeCA8LSBwcmVkaWN0KHdjLCBjYXJ0KSANCnggPC0gbWFzayh4LCB3Y1tbMV1dKSANCnggPC0gcm91bmQoeCwgMikgDQpwbG90KHgsIHR5cGU9ImNsYXNzIiwgcGxnPWxpc3QoeD0iYm90dG9tbGVmdCIpKSANCmBgYA0KDQojIyBSYW5kb20gRm9yZXN0IA0KIyMjIFRlc3QgYW5kIFRyYWluIERhdGENCmBgYHtyfQ0Kc2V0LnNlZWQoMTIzKSANCmkgPC0gc2FtcGxlKG5yb3coZHcpLCAwLjIgKiBucm93KGR3KSkgDQp0ZXN0IDwtIGR3W2ksXSANCnRyYWluIDwtIGR3Wy1pLF0gDQpmcGEgPC0gYXMuZmFjdG9yKHRyYWluWywgJ3BhJ10pIA0KYGBgDQojIyMgUmFuZG9tRm9yZXN0IG1vZGVsIA0KYGBge3J9DQpsaWJyYXJ5KHJhbmRvbUZvcmVzdCkgIyMjcmFuZG9tRm9yZXN0IDQuNy0xLjEgIyMjVHlwZSByZk5ld3MoKSB0byBzZWUgbmV3IGZlYXR1cmVzL2NoYW5nZXMvYnVnIGZpeGVzLiANCmNyZiA8LSByYW5kb21Gb3Jlc3QodHJhaW5bLCAyOm5jb2wodHJhaW4pXSwgZnBhKSANCmNyZg0KYGBgDQojIyMgdmFyaWFibGUgaW1wb3J0YW5jZSBwbG90DQpgYGB7cn0NCnZhckltcFBsb3QoY3JmKSANCmBgYA0KIyMjIHVzZSByZWdyZXNzaW9uICggdHVuZSBhIHBhcmFtZXRlciApDQpgYGB7cn0NCnRyZiA8LSB0dW5lUkYodHJhaW5bLCAyOm5jb2wodHJhaW4pXSwgdHJhaW5bLCAicGEiXSkgDQp0cmYgDQptdCA8LSB0cmZbd2hpY2gubWluKHRyZlssMl0pLCAxXSANCm10IA0KYGBgDQojIyMgdHVuZVJGIGFuZCB2YWx1ZXMgb2YgbXQgcmVwcmVzZW4NCmBgYHtyfQ0KcnJmIDwtIHJhbmRvbUZvcmVzdCh0cmFpblssIDI6bmNvbCh0cmFpbildLCB0cmFpblssICJwYSJdLCBtdHJ5PW10LCBudHJlZT0yNTApIA0KcGxvdChycmYpIA0KYGBgDQojIFByZWRpY3QgDQojIyBSZWdyZXNzaW9uIA0KYGBge3J9DQpycCA8LSBwcmVkaWN0KHdjLCBycmYsIG5hLnJtPVRSVUUpDQpwbG90KHJwKSANCmBgYA0KIyMjIG9wdGltYWwgdGhyZXNob2xkDQpgYGB7cn0NCmxpYnJhcnkocHJlZGljdHMpIA0KZXZhIDwtIHBhX2V2YWx1YXRlKHByZWRpY3QocnJmLCB0ZXN0W3Rlc3QkcGE9PTEsIF0pLCBwcmVkaWN0KHJyZiwgdGVzdFt0ZXN0JHBhPT0wLCBdKSkgDQpldmEgDQpgYGANCiMjIyBST0MNCmBgYHtyfQ0KcGxvdChldmEsICJST0MiKSANCmBgYA0KIyMgQm94IHBsb3QgYW5kIHByZWRpY3RpdmUgdmFsdWUNCmBgYHtyfQ0KcGFyKG1mcm93PWMoMSwyKSkgDQpwbG90KGV2YSwgImJveHBsb3QiKSANCnBsb3QoZXZhLCAiZGVuc2l0eSIpIA0KYGBgDQojIyMgdXNlIHRoZSDigJxtYXggc3BlY2lmaWNpdHkgKyBzZW5zaXRpdml0eeKAnSB0aHJlc2hvbGQNCmBgYHtyfQ0KdHIgPC0gZXZhQHRocmVzaG9sZHMgDQp0ciAjIyBtYXhfa2FwcGEgbWF4X3NwZWNfc2VucyBub19vbWlzc2lvbiBlcXVhbF9wcmV2YWxlbmNlIGVxdWFsX3NlbnNfc3BlYyANCiMjIDEgMC40NDY5NjY3IDAuMzIxOTg1NiAwLjAwNDI1OTczIDAuMTk1MjMzMyAwLjIxNjcyMzkNCnBsb3QocnAgPiB0ciRtYXhfc3BlY19zZW5zKSANCmBgYA0KIyMgQ2xhc3NpZmljYXRpb24gDQojIyMgY2xhc3NpZmljYXRpb24gUmFuZG9tIEZvcmVzdCBtb2RlbCANCmBgYHtyfQ0KcmMgPC0gcHJlZGljdCh3YywgY3JmLCBuYS5ybT1UUlVFKSANCnBsb3QocmMpIA0KYGBgDQojIyMgQWRkIHByb2JhYmlsaXR5DQpgYGB7cn0NCnJjMiA8LSBwcmVkaWN0KHdjLCBjcmYsIHR5cGU9InByb2IiLCBuYS5ybT1UUlVFKSANCnBsb3QocmMyLCAyKSANCmBgYA0KIyMgRXh0cmFwb2xhdGlvbg0KIyMjIERpc3RyaWJ1dGlvbiBvZiB0aGUgRWFzdGVybiBzcGVjaWVzDQpgYGB7cn0NCmV2YTIgPC0gcGFfZXZhbHVhdGUocHJlZGljdChycmYsIGRlW2RlJHBhPT0xLCBdKSwgcHJlZGljdChycmYsIGRlW2RlJHBhPT0wLCBdKSkgDQpldmEyIA0KYGBgDQojIyMgUGxvdA0KYGBge3J9DQpwYXIobWZyb3c9YygxLDIpKSANCnBsb3QoZXZhMiwgIlJPQyIpIA0KcGxvdChldmEyLCAiYm94cGxvdCIpIA0KYGBgDQojIyMgb3VyIG1vZGVsIGlzIHJlYWxseSBnb29kIGluIHByZWRpY3RpbmcgdGhlIHJhbmdlIG9mIHRoZSBXZXN0LCBidXQgaXQgY2Fubm90IGV4dHJhcG9sYXRlIGF0IGFsbCB0byB0aGUgRWFzdC4gDQpgYGB7cn0NCnBsb3QocmMpIA0KcG9pbnRzKGJmWywxOjJdLCBjZXg9LjI1KSANCmBgYA0KIyMgV29ybGQgTWFwDQpgYGB7cn0NCndpbmRvdyh3YykgPC0gTlVMTCANCnBtIDwtIHByZWRpY3Qod2MsIHJyZiwgbmEucm09VFJVRSkgDQpwbG90KHBtKSANCmxpbmVzKHdybGQpIA0KYGBgDQojIyBlc3RpbWF0ZSByYW5nZSBzaGlmdHMgZHVlIHRvIGNsaW1hdGUgY2hhbmdlDQpgYGB7cn0NCmZ1dCA8LSBjbWlwNl93b3JsZCgiQ05STS1DTTYtMSIsICI1ODUiLCAiMjA2MS0yMDgwIiwgdmFyPSJiaW8iLCByZXM9MTAsIHBhdGg9Ii4iKSANCm5hbWVzKGZ1dCkNCm5hbWVzKGZ1dCkgPC0gbmFtZXMod2MpIA0Kd2luZG93KGZ1dCkgPC0gZXh0X2JmIA0KcGZ1dCA8LSBwcmVkaWN0KGZ1dCwgcnJmLCBuYS5ybT1UUlVFKSANCnBsb3QocGZ1dCkgDQpgYGANCg0K