A=matrix(c(0,60,20,5,0.3,0,0,0,0,0.4,0,0,0,0,0.25,0), nr=4, byrow = T)
A
##      [,1] [,2]  [,3] [,4]
## [1,]  0.0 60.0 20.00    5
## [2,]  0.3  0.0  0.00    0
## [3,]  0.0  0.4  0.00    0
## [4,]  0.0  0.0  0.25    0
N0=matrix(c(400,100,200,50), ncol=1)
N0
##      [,1]
## [1,]  400
## [2,]  100
## [3,]  200
## [4,]   50
years=20
n.projections=matrix(0,nrow=nrow(A), ncol=years+1)
n.projections
##      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
## [1,]    0    0    0    0    0    0    0    0    0     0     0     0     0
## [2,]    0    0    0    0    0    0    0    0    0     0     0     0     0
## [3,]    0    0    0    0    0    0    0    0    0     0     0     0     0
## [4,]    0    0    0    0    0    0    0    0    0     0     0     0     0
##      [,14] [,15] [,16] [,17] [,18] [,19] [,20] [,21]
## [1,]     0     0     0     0     0     0     0     0
## [2,]     0     0     0     0     0     0     0     0
## [3,]     0     0     0     0     0     0     0     0
## [4,]     0     0     0     0     0     0     0     0
n.projections[,1]=N0
n.projections
##      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
## [1,]  400    0    0    0    0    0    0    0    0     0     0     0     0
## [2,]  100    0    0    0    0    0    0    0    0     0     0     0     0
## [3,]  200    0    0    0    0    0    0    0    0     0     0     0     0
## [4,]   50    0    0    0    0    0    0    0    0     0     0     0     0
##      [,14] [,15] [,16] [,17] [,18] [,19] [,20] [,21]
## [1,]     0     0     0     0     0     0     0     0
## [2,]     0     0     0     0     0     0     0     0
## [3,]     0     0     0     0     0     0     0     0
## [4,]     0     0     0     0     0     0     0     0
for (i in 1:years) n.projections[,i+1]=A%*%n.projections[,i]
n.projections
##      [,1]  [,2] [,3]   [,4]     [,5]      [,6]      [,7]       [,8]
## [1,]  400 10250 8250 185510 173160.0 3360517.5 3563341.5 60932725.5
## [2,]  100   120 3075   2475  55653.0   51948.0 1008155.2  1069002.4
## [3,]  200    40   48   1230    990.0   22261.2   20779.2   403262.1
## [4,]   50    50   10     12    307.5     247.5    5565.3     5194.8
##            [,9]        [,10]      [,11]       [,12]       [,13]
## [1,] 72231363.0 1105845156.2 1446937576 20087707992 28709739455
## [2,] 18279817.6   21669408.9  331753547   434081273  6026312398
## [3,]   427601.0    7311927.1    8667764   132701419   173632509
## [4,]   100815.5     106900.2    1827982     2166941    33175355
##             [,14]        [,15]        [,16]        [,17]        [,18]
## [1,] 365217270814 565202850008 6.645827e+12 1.105448e+13 1.210362e+14
## [2,]   8612921837 109565181244 1.695609e+11 1.993748e+12 3.316344e+12
## [3,]   2410524959   3445168735 4.382607e+10 6.782434e+10 7.974993e+11
## [4,]     43408127    602631240 8.612922e+08 1.095652e+10 1.695609e+10
##             [,19]        [,20]        [,21]
## [1,] 2.150154e+14 2.206179e+15 4.162422e+15
## [2,] 3.631085e+13 6.450462e+13 6.618536e+14
## [3,] 1.326538e+12 1.452434e+13 2.580185e+13
## [4,] 1.993748e+11 3.316344e+11 3.631085e+12
# Gráfica por estados
matplot(0:years, t(n.projections), type = "l", lty = 1:3,col = 1, ylab = "Abundancia", xlab = "Año")
legend("topleft", legend = c("Semillas", "Adultos pequeños", "Adultos medianos", "Adultos grandes"),lty = 1:4, col = 1, bty = "n")

# Tasa de crecimiento anual (El lambda general de la población es el valor que converge en el tiempo), lambda=Nt+1/Nt para cada año. 
# Primero necesitamos la suma de todos los estados aplicando la función sum a cada columna.
n.totals=(apply(n.projections,2,sum))
n.totals
##  [1] 7.500000e+02 1.046000e+04 1.138300e+04 1.892270e+05 2.301105e+05
##  [6] 3.434974e+06 4.597841e+06 6.241018e+07 9.103960e+07 1.134933e+09
## [11] 1.789187e+09 2.065666e+10 3.494286e+10 3.762841e+11 6.788158e+11
## [16] 6.860076e+12 1.312701e+13 1.251670e+14 2.528522e+14 2.285539e+15
## [21] 4.853709e+15
# Ahora obtenemos cada Lambda dividiendo todos los Nt+1 por cada Nt.
lambdas=n.totals[-1]/n.totals[-(years+1)]
lambdas
##  [1] 13.946667  1.088241 16.623649  1.216055 14.927499  1.338537 13.573802
##  [8]  1.458730 12.466371  1.576469 11.545277  1.691603 10.768556  1.803998
## [15] 10.105945  1.913537  9.535071  2.020119  9.039034  2.123660
#Tenemos un lamba menos que años, ploteamos cada lambda en cada t en vez de en cada t+1
plot(0:(years-1),lambdas,type="b",xlab = "Year",ylab = "L")

#Los lambda que obtuvimos no convergen en el tiempo entonces necesitamos más unidades de tiempo, la covergencia se da en el año 606
t=700
Nt=N0/sum(N0)
L.t=numeric(t)
#Creamos una iteración (for-loop) que reusa Nt para cada paso del tiempo, asegurandonos que tengamos un vector numerico vacio para sostener las salidas 
for (i in 1:t) L.t[i] <- {
Nt1 <- A %*% Nt
L <- sum(Nt1)/sum(Nt)
Nt <- Nt1/sum(Nt1)
L
}
#Comparamos el resultado directamente al punto estimado de lambda
par(mar = c(5, 4, 3, 2))
plot(1:t, L.t, type = "b", main = quote("Convergencia hacia " * lambda))
L.t
##   [1] 13.946667  1.088241 16.623649  1.216055 14.927499  1.338537 13.573802
##   [8]  1.458730 12.466371  1.576469 11.545277  1.691603 10.768556  1.803998
##  [15] 10.105945  1.913537  9.535071  2.020119  9.039034  2.123660  8.604828
##  [22]  2.224093  8.222282  2.321366  7.883328  2.415443  7.581480  2.506303
##  [29]  7.311468  2.593936  7.068963  2.678348  6.850376  2.759556  6.652708
##  [36]  2.837587  6.473431  2.912479  6.310401  2.984279  6.161785  3.053040
##  [43]  6.026011  3.118825  5.901718  3.181701  5.787725  3.241740  5.683002
##  [50]  3.299020  5.586645  3.353621  5.497859  3.405626  5.415941  3.455120
##  [57]  5.340268  3.502191  5.270286  3.546925  5.205498  3.589410  5.145463
##  [64]  3.629734  5.089781  3.667984  5.038095  3.704246  4.990080  3.738606
##  [71]  4.945445  3.771145  4.903924  3.801946  4.865275  3.831089  4.829280
##  [78]  3.858650  4.795739  3.884705  4.764468  3.909326  4.735300  3.932585
##  [85]  4.708083  3.954548  4.682675  3.975282  4.658947  3.994849  4.636780
##  [92]  4.013309  4.616065  4.030721  4.596702  4.047139  4.578595  4.062616
##  [99]  4.561660  4.077204  4.545816  4.090949  4.530990  4.103899  4.517113
## [106]  4.116097  4.504122  4.127584  4.491958  4.138401  4.480566  4.148583
## [113]  4.469896  4.158168  4.459900  4.167190  4.450534  4.175679  4.441757
## [120]  4.183666  4.433531  4.191181  4.425821  4.198251  4.418593  4.204900
## [127]  4.411816  4.211154  4.405462  4.217035  4.399504  4.222565  4.393917
## [134]  4.227765  4.388677  4.232654  4.383761  4.237250  4.379151  4.241571
## [141]  4.374826  4.245633  4.370768  4.249450  4.366962  4.253038  4.363390
## [148]  4.256411  4.360038  4.259580  4.356894  4.262558  4.353943  4.265357
## [155]  4.351173  4.267987  4.348574  4.270458  4.346135  4.272780  4.343846
## [162]  4.274961  4.341697  4.277011  4.339681  4.278936  4.337788  4.280745
## [169]  4.336011  4.282445  4.334343  4.284041  4.332777  4.285541  4.331308
## [176]  4.286950  4.329928  4.288274  4.328633  4.289517  4.327417  4.290685
## [183]  4.326275  4.291782  4.325204  4.292812  4.324198  4.293780  4.323253
## [190]  4.294689  4.322366  4.295543  4.321533  4.296345  4.320752  4.297098
## [197]  4.320018  4.297805  4.319329  4.298470  4.318682  4.299094  4.318074
## [204]  4.299680  4.317504  4.300230  4.316968  4.300747  4.316465  4.301233
## [211]  4.315993  4.301689  4.315549  4.302117  4.315133  4.302519  4.314742
## [218]  4.302897  4.314375  4.303252  4.314030  4.303585  4.313707  4.303898
## [225]  4.313403  4.304192  4.313118  4.304468  4.312850  4.304727  4.312598
## [232]  4.304970  4.312362  4.305199  4.312140  4.305413  4.311932  4.305615
## [239]  4.311736  4.305804  4.311552  4.305982  4.311380  4.306149  4.311218
## [246]  4.306306  4.311066  4.306453  4.310923  4.306591  4.310789  4.306721
## [253]  4.310663  4.306843  4.310545  4.306958  4.310434  4.307065  4.310329
## [260]  4.307166  4.310231  4.307261  4.310139  4.307350  4.310053  4.307434
## [267]  4.309972  4.307512  4.309896  4.307586  4.309824  4.307655  4.309757
## [274]  4.307720  4.309694  4.307781  4.309635  4.307839  4.309579  4.307892
## [281]  4.309527  4.307943  4.309478  4.307990  4.309432  4.308035  4.309389
## [288]  4.308077  4.309348  4.308116  4.309310  4.308153  4.309274  4.308188
## [295]  4.309241  4.308220  4.309209  4.308251  4.309179  4.308280  4.309152
## [302]  4.308307  4.309125  4.308332  4.309101  4.308356  4.309078  4.308378
## [309]  4.309056  4.308399  4.309036  4.308419  4.309017  4.308437  4.308999
## [316]  4.308455  4.308982  4.308471  4.308966  4.308486  4.308951  4.308501
## [323]  4.308937  4.308514  4.308924  4.308527  4.308912  4.308539  4.308900
## [330]  4.308550  4.308890  4.308561  4.308879  4.308570  4.308870  4.308580
## [337]  4.308861  4.308588  4.308852  4.308597  4.308844  4.308604  4.308837
## [344]  4.308611  4.308830  4.308618  4.308824  4.308625  4.308817  4.308631
## [351]  4.308812  4.308636  4.308806  4.308641  4.308801  4.308646  4.308796
## [358]  4.308651  4.308792  4.308655  4.308788  4.308659  4.308784  4.308663
## [365]  4.308780  4.308667  4.308776  4.308670  4.308773  4.308673  4.308770
## [372]  4.308676  4.308767  4.308679  4.308764  4.308682  4.308762  4.308684
## [379]  4.308759  4.308687  4.308757  4.308689  4.308755  4.308691  4.308753
## [386]  4.308693  4.308751  4.308695  4.308749  4.308696  4.308748  4.308698
## [393]  4.308746  4.308699  4.308745  4.308701  4.308743  4.308702  4.308742
## [400]  4.308703  4.308741  4.308705  4.308740  4.308706  4.308739  4.308707
## [407]  4.308738  4.308708  4.308737  4.308709  4.308736  4.308709  4.308735
## [414]  4.308710  4.308734  4.308711  4.308734  4.308712  4.308733  4.308712
## [421]  4.308732  4.308713  4.308732  4.308713  4.308731  4.308714  4.308731
## [428]  4.308715  4.308730  4.308715  4.308730  4.308715  4.308729  4.308716
## [435]  4.308729  4.308716  4.308728  4.308717  4.308728  4.308717  4.308728
## [442]  4.308717  4.308727  4.308718  4.308727  4.308718  4.308727  4.308718
## [449]  4.308727  4.308719  4.308726  4.308719  4.308726  4.308719  4.308726
## [456]  4.308719  4.308726  4.308719  4.308725  4.308720  4.308725  4.308720
## [463]  4.308725  4.308720  4.308725  4.308720  4.308725  4.308720  4.308725
## [470]  4.308720  4.308725  4.308720  4.308724  4.308721  4.308724  4.308721
## [477]  4.308724  4.308721  4.308724  4.308721  4.308724  4.308721  4.308724
## [484]  4.308721  4.308724  4.308721  4.308724  4.308721  4.308724  4.308721
## [491]  4.308724  4.308721  4.308723  4.308721  4.308723  4.308722  4.308723
## [498]  4.308722  4.308723  4.308722  4.308723  4.308722  4.308723  4.308722
## [505]  4.308723  4.308722  4.308723  4.308722  4.308723  4.308722  4.308723
## [512]  4.308722  4.308723  4.308722  4.308723  4.308722  4.308723  4.308722
## [519]  4.308723  4.308722  4.308723  4.308722  4.308723  4.308722  4.308723
## [526]  4.308722  4.308723  4.308722  4.308723  4.308722  4.308723  4.308722
## [533]  4.308723  4.308722  4.308723  4.308722  4.308723  4.308722  4.308723
## [540]  4.308722  4.308723  4.308722  4.308723  4.308722  4.308723  4.308722
## [547]  4.308723  4.308722  4.308723  4.308722  4.308723  4.308722  4.308723
## [554]  4.308722  4.308723  4.308722  4.308723  4.308722  4.308723  4.308722
## [561]  4.308723  4.308722  4.308723  4.308722  4.308723  4.308722  4.308723
## [568]  4.308722  4.308723  4.308722  4.308723  4.308722  4.308723  4.308722
## [575]  4.308723  4.308722  4.308723  4.308722  4.308723  4.308722  4.308723
## [582]  4.308722  4.308723  4.308722  4.308723  4.308722  4.308723  4.308722
## [589]  4.308723  4.308722  4.308723  4.308722  4.308723  4.308722  4.308723
## [596]  4.308722  4.308723  4.308722  4.308723  4.308722  4.308723  4.308722
## [603]  4.308723  4.308722  4.308723  4.308722  4.308722  4.308722  4.308722
## [610]  4.308722  4.308722  4.308722  4.308722  4.308722  4.308722  4.308722
## [617]  4.308722  4.308722  4.308722  4.308722  4.308722  4.308722  4.308722
## [624]  4.308722  4.308722  4.308722  4.308722  4.308722  4.308722  4.308722
## [631]  4.308722  4.308722  4.308722  4.308722  4.308722  4.308722  4.308722
## [638]  4.308722  4.308722  4.308722  4.308722  4.308722  4.308722  4.308722
## [645]  4.308722  4.308722  4.308722  4.308722  4.308722  4.308722  4.308722
## [652]  4.308722  4.308722  4.308722  4.308722  4.308722  4.308722  4.308722
## [659]  4.308722  4.308722  4.308722  4.308722  4.308722  4.308722  4.308722
## [666]  4.308722  4.308722  4.308722  4.308722  4.308722  4.308722  4.308722
## [673]  4.308722  4.308722  4.308722  4.308722  4.308722  4.308722  4.308722
## [680]  4.308722  4.308722  4.308722  4.308722  4.308722  4.308722  4.308722
## [687]  4.308722  4.308722  4.308722  4.308722  4.308722  4.308722  4.308722
## [694]  4.308722  4.308722  4.308722  4.308722  4.308722  4.308722  4.308722
#Usando ánalysis de valores y vectores "propios" (Eigenanalysis) de la matriz tambien podemos llegar a la convergencia de lambda
eigs.A=eigen(A)
eigs.A
## eigen() decomposition
## $values
## [1]  4.30872247+0.00000000i -4.17538096+0.00000000i -0.06667076+0.06239164i
## [4] -0.06667076-0.06239164i
## 
## $vectors
##                  [,1]             [,2]                    [,3]
## [1,] -0.9975640650+0i  0.9974051688+0i  0.01504872+0.01838392i
## [2,] -0.0694566015+0i -0.0716632934+0i  0.00517024-0.07788416i
## [3,] -0.0064479996+0i  0.0068653178+0i -0.24966217+0.23363815i
## [4,] -0.0003741248+0i -0.0004110594+0i  0.93617568+0.00000000i
##                         [,4]
## [1,]  0.01504872-0.01838392i
## [2,]  0.00517024+0.07788416i
## [3,] -0.24966217-0.23363815i
## [4,]  0.93617568+0.00000000i
dom.pos=which.max(eigs.A[["values"]])
## Warning in which.max(eigs.A[["values"]]): imaginary parts discarded in
## coercion
L1 <- Re(eigs.A[["values"]][dom.pos])
L1
## [1] 4.308722
points(t, L1, pch = 19, cex = 1.5)

#La distribución estable de estados se alcanza cuando la abundancia relativa de los estados es la misma
w <- Re(eigs.A[["vectors"]][, dom.pos])
ssd <- w/sum(w)
round(ssd, 3)
## [1] 0.929 0.065 0.006 0.000
# Lo anterior muestra que si la matriz de projección no cambia en el tiempo, estara compuesta de los porcentajes calculados para cada estado
#El valor reproductivo es el número de individuos a nacer de una determinada edad, lo calculamos con la matriz transpuesta de la matriz de proyecciones (A)
M <- eigen(t(A))
v <- Re(M$vectors[, which.max(Re(M$values))])
v
## [1] 0.06582356 0.94538480 0.30996825 0.07638408
RV <- v/v[1]
round(RV,3)
## [1]  1.000 14.362  4.709  1.160
#La importancia relativa de cada transición del ciclo de vida se hace calculando la "sensibilidad" y "elasticidad" de la matriz
#Las sensibilidades son la contribución directa de cada transición a lambda
vw.s <- v %*% t(w)
(S <- vw.s/as.numeric(v %*% w))
##           [,1]       [,2]        [,3]         [,4]
## [1,] 0.4923990 0.03428387 0.003182741 0.0001846685
## [2,] 7.0720349 0.49239896 0.045711829 0.0026522844
## [3,] 2.3187450 0.16144542 0.014987776 0.0008696183
## [4,] 0.5713979 0.03978427 0.003693370 0.0002142961
#Las elasticidades son sensibilidades ponderadas por las probabilidades de transición
elas <- (A/L1) * S
round(elas, 3)
##       [,1]  [,2]  [,3] [,4]
## [1,] 0.000 0.477 0.015    0
## [2,] 0.492 0.000 0.000    0
## [3,] 0.000 0.015 0.000    0
## [4,] 0.000 0.000 0.000    0
#Dos propiedades importantes tienen estas elasticidades, transiciones imposibles tienen elasticidades iguales a cero y todas las elasticidades de la matriz suman uno
#Así es facil comparar elasticidades para diferentes matrices y diferentes organismos
#Lo anterior es importante en el manejo de especies invasoras o en peligro donde buscamos tener el maximo impacto con el mínimo esfuerzo