setwd("~/Dropbox/Clases_UPJ/BiologÃa de poblaciones/Alumnos_BioP/2019_10/Examen II")
## Punto 1
# Tasa intrÃnseca de crecimiento
datos1<-read.table("inva.csv", sep = ",", header=T)
datos1
## año n
## 1 1962 2
## 2 1975 200
## 3 1986 264
## 4 1989 328
## 5 1994 2200
## 6 1999 3955
attach(datos1)
plot (año, n)
datos1.tra<-transform(datos1, n=log(n), año=año-1962)
detach(datos1)
attach(datos1.tra)
plot (año, n)
fit1<-lm(n~año)
abline(fit1)
summary(fit1)
##
## Call:
## lm(formula = n ~ año)
##
## Residuals:
## 1 2 3 4 5 6
## -0.69394 1.46597 -0.32546 -0.67268 0.29003 -0.06393
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.38709 0.75809 1.830 0.14127
## año 0.18810 0.02986 6.299 0.00325 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.9052 on 4 degrees of freedom
## Multiple R-squared: 0.9084, Adjusted R-squared: 0.8855
## F-statistic: 39.68 on 1 and 4 DF, p-value: 0.003246
# Tiempo doble
(t2<-log(2)/0.18810)
## [1] 3.684993
# Tiempo necesario para alcanzar 20000 individuos
m.time1<-function(r, N=20000) {(log(N)-1.38709)/r}
rs<-c(0.1881*2,0.1881*3,0.1881*4)
m.time1(rs)
## [1] 22.63795 15.09197 11.31898
### Sección II
## A: Matriz
A=matrix(c(0,40,50,20,0.25,0,0,0,0,0.4,0,0,0,0,0.25,0), nr=4, byrow = T)
A
## [,1] [,2] [,3] [,4]
## [1,] 0.00 40.0 50.00 20
## [2,] 0.25 0.0 0.00 0
## [3,] 0.00 0.4 0.00 0
## [4,] 0.00 0.0 0.25 0
nt=matrix(c(400,100,250,75), ncol=1)
nt
## [,1]
## [1,] 400
## [2,] 100
## [3,] 250
## [4,] 75
## B: Proyección a 2 años
nt1= A %*% nt
nt1
## [,1]
## [1,] 18000.0
## [2,] 100.0
## [3,] 40.0
## [4,] 62.5
nt2= A %*% nt1
nt2
## [,1]
## [1,] 7250
## [2,] 4500
## [3,] 40
## [4,] 10
##Cálculo de lambdas
# Primero necesitamos la suma de todos los estados aplicando la función sum a nt2.
nt.totals=(apply(nt,2,sum))
nt.totals
## [1] 825
nt1.totals=(apply(nt1,2,sum))
nt1.totals
## [1] 18202.5
nt2.totals=(apply(nt2,2,sum))
nt2.totals
## [1] 11800
# Ahora obtenemos Lambda dividiendo Nt+1 entre Nt.
lambda1=nt1.totals/nt.totals
lambda2=nt2.totals/nt1.totals
lambda1
## [1] 22.06364
lambda2
## [1] 0.6482626
#Efectos del tamaño poblacional inicial, la variable de interés varia el resto de la ecuación se queda constante
N0<-c(10,20,30)
lambda<-0.64
time<-0:10
#Calculamos el tamaño poblacional usando sapply para aplicar una función a cada elemento del primer argumento
Nt.s<-sapply(N0, function(n) n*lambda^time)
Nt.s
## [,1] [,2] [,3]
## [1,] 10.0000000 20.0000000 30.0000000
## [2,] 6.4000000 12.8000000 19.2000000
## [3,] 4.0960000 8.1920000 12.2880000
## [4,] 2.6214400 5.2428800 7.8643200
## [5,] 1.6777216 3.3554432 5.0331648
## [6,] 1.0737418 2.1474836 3.2212255
## [7,] 0.6871948 1.3743895 2.0615843
## [8,] 0.4398047 0.8796093 1.3194140
## [9,] 0.2814750 0.5629500 0.8444249
## [10,] 0.1801440 0.3602880 0.5404320
## [11,] 0.1152922 0.2305843 0.3458765
##Efecto de diferentes tasas per capita
# Se modela cuando lambda es mayor a 1 y cuando lambda es menor a 1, ya creamos el tiempo, entonces:
N0<-nt.totals
N0
## [1] 825
lambdas <- c(0.64, 1, 1.14)
N.all <- sapply(lambdas, function(x) N0 * x^time)
N.all
## [,1] [,2] [,3]
## [1,] 825.000000 825 825.000
## [2,] 528.000000 825 940.500
## [3,] 337.920000 825 1072.170
## [4,] 216.268800 825 1222.274
## [5,] 138.412032 825 1393.392
## [6,] 88.583700 825 1588.467
## [7,] 56.693568 825 1810.852
## [8,] 36.283884 825 2064.372
## [9,] 23.221686 825 2353.384
## [10,] 14.861879 825 2682.858
## [11,] 9.511602 825 3058.458
##Graficando resultados
layout(matrix(1:2,1,2)) # se divide la pantalla gráfica
matplot(time, Nt.s, pch = 1:3) # resultados de diferentes tamaños poblacionales
#resultados de diferentes lambdas
matplot(time, N.all, xlab = "Years", ylab = "N", pch = 1:3)
abline(h = N0, lty = 3)
text(1, 2000, expression(lambda > 1), cex = 1.2)
text(1, 10, expression(lambda < 1), cex = 1.2)
