Creditos: diegokjkjj
Chaudhary, V., Oli, M. K. A critical appraisal of population viability analysis. Conservation Biology, 2019. v.34, n.1, p.26-40. Doi: 10.1111/cobi.13414
Análise levantada pelo artigo, mostrando que a qualidade das análises PVA ao longo dos anos vem caindo, principalmente devido às suas poucas especificidades.
![Paterson, J. E., Carstairs, S., Davy, C. M. Population-level effects of wildlife rehabilitation and release vary with life-history strategy. Journal of Nature Conservation, 2021. v.61, p.125983. Doi: 10.1016/j.jnc.2021.125983
Análises PVA dos 5 animais selecionados, mostrando os crescimento populacional de cada animal de acordo com a porcentagem de injúrias sofridas naquela população.
Análise de PVA dos 5 animais selecionadis, avaliando o crescimento populacional de acordo com os níveis de reabilitação (cores das linhas) em relação à porcentagem de injúrias severas sofridas pelas populações.
\[ \tag{1} \mathrm{H'}=\Sigma_{i=1}^{S}\mathrm{Pi*LnPi} \]
\[ \tag{2} \mathrm{D}=1-\Sigma_{i=1}^{S}\mathrm{Pi^2} \]
Diferentes tipo de gráficos e análises feitas no software Vortex.
Print da tela onde está sendo escrito o script do RMardown desta mesma página onde você está lendo isso agora.
r.m<-1.15
a.i<-51
k<-175
ds.cpa <- 0.11
Ricker <- function(prev_abund){ # Esta é uma função para calcular a abundância do próximo ano - inclui estocasticidade ambiental
prev_abund * exp(log(rnorm(1,r.m,ds.cpa))*(1-(prev_abund/k)))
}
p.e <- 0.05
s.e <- 0.25
n.a <- 100
n.r <- 500
PVAdemo <- function(n.r,n.a,a.i,r.m,k,p.e,s.e){
#browser()
PopArray2 <- array(0,dim=c((n.a+1),n.r)) # configurando matriz de armazenamento
## iniciando o loop através de réplicas
for(rep in 1:n.r){
# definindo abundância inicial
PopArray2[1,rep] <- a.i # set the initial abundance
### loop através dos anos
for(y in 2:(n.a+1)){
### estocasticidade e d-d
nextyear <- max(0,trunc(Ricker(PopArray2[y-1,rep])))
### catastrofe
if(runif(1)<p.e) nextyear <- nextyear*s.e
PopArray2[y,rep] <- nextyear
}
}
return(PopArray2)
}
Default <- PVAdemo(n.r,n.a,a.i,r.m,k,p.e,s.e)
PlotCloud <- function(simdata){
plot(c(1:101),simdata[,1],col="red",type="l",ylim=c(0,max(simdata)),xlab="Years",ylab="Abundance")
#for(r in 2:ncol(simdata)){
# lines(c(1:101),simdata[,r],col=gray(0.9),type="l")
#}
}
PlotCloud(Default)
Extinction_byyear <- function(simdata){
apply(simdata,1,function(t) length(which(t==0)))/ncol(simdata)
}
plot(c(1:101),Extinction_byyear(Default),type="l",lwd=2,xlab="anos",ylab="risco de extinção")+
abline(h=p.e,col="red",lwd=2)
## integer(0)
hist(Default[nrow(Default),],xlab="Abundância final após 100 anos",ylab="Nº de réplicas",main="")
abline(v=a.i,col="green",lwd=2)
declines <- seq(0,100,by=1)
declineprob <- numeric(length(declines))
for(s in 1:length(declines)){
declineprob[s] <- length(which(Default[nrow(Default),]<(a.i-(declines[s]/100)*a.i)))/ncol(Default)
}
plot(declines,declineprob,type="l",lwd=2,xlab="Limite de declínio (%)",ylab="Probabilidade de extinção abaixo do limite")+
abline(v=25,col="red",lwd=2)
## integer(0)