miércoles, 12 de enero de 2011

Dinámica poblacional en el espacio. Aplicaciones con R (paquetes deSolve y primer)

Dinámica poblacional en el espacio


3. Dinámica espacial
 
 
Dinámica fuente-sumidero
 
#### 1) DINÁMICA FUENTE-SUMIDERO ####
L1 <- 2; L2 <- 0.4; A <- matrix(c(1, 0, L1 - 1, L2), nrow = 2, byrow = TRUE) #creamos la matriz A de Pulliam
eigen(A) #realizamos el análisis propio, donde el valor propio dominante da el crecimiento poblacional total asintótico a largo plazo y podemos obtener la distribución de estado estable (distribución de los individuos entre los dos hábitats). la población sumidero tiene actualmente más individuos que la población fuente (.51/(.51+.86)<.5)
L1s <- seq(1, 3, by = 0.01); p1 <- sapply(L1s, function(l1) { A[2, 1] <- l1 - 1; eigen(A)$vectors[1, 1]/sum(eigen(A)$vectors[, 1]) }); plot(L1s, p1, type = "l", ylab = "Source Population", xlab = expression(lambda[1])) # graficamos los resultados para un rango de lambda1, donde p1 es la proporción de la población en la fuente,
 
 
 
Dinámica metapoblacional
 
#### 2) DOS TIPOS DE METAPOBLACIONES: colección de sitios conectados por dispersión y cada uno sujeto de extinción. Ambos modelos calculan la proporción de sitios que están ocupados.
#I. Una población estructurada espacialmente: población cerrada donde los individuos ocupan sitios en un contexto espacial implícito. un sitios es ocupado por un individuo. Cuanto más sitios estén ocupados ,menor será la chance de que un propágulo alcance un sitio desocupado. Los sitios se liberan al morir los individuos.
#II. Metapoblación: población de poblaciones. Cada sitio es una localización que contiene o no una población. La metapoblación es cerrada (existe un número finito de sitios que puede intercambiar migrantes).
#asumimos: todos los sitios presentan iguales tasas. La siguiente herramienta matemática describe nuestros dos tipos de modelos. consideraremos cómo la tasa total de colonización C y extinción E influye en la tasa de cambio p, la proporción de sitios que está ocupado dp/dt=C-E.
#permutaciones de cómo representar las tasas de colonización y extinción.
 
Modelo de Levins
 
#i) Levins. modelo de Levins clásico: dp/dt=ci*p*(1-p)-e*p
levins <- function(t, y, parms) { p <- y[1]; with(as.list(parms), { dp <- ci * p * (1 - p) - e * p; return(list(dp)) }) }
library(deSolve); prms <- c(ci = 0.15, e = 0.05); Initial.p <- 0.01; out.L <- data.frame(ode(y = Initial.p, times = 1:100, func = levins, parms = prms))
plot(out.L[, 2] ~ out.L[, 1], type = "l", ylim = c(0, 1), ylab = "p", xlab = "time")
 
Utilizando el paquete “deSolve” la simulación se reduce a:
#This model implements a Levins-type metapopulation model for two species, after Hastings (1980).For use with ode in the deSolve package.
library(deSolve)
pars <- c(c1 = .3, c2 = 1, m1 = .1, m2 = .1)
pops <- c(.1,.1)
out <- ode(y=pops, t=0:20, fun=compcol, parms = pars)
matplot(out[,1], out[,-1], type='l')
 
 
Utilizando el paquete “deSolve” la simulación se reduce a:
#A function for the classic metaapopulation dynamics, for use with ode in the deSolve package.
function (t, y, parms)
{
p <- y[1]
with(as.list(parms), { dp <- ci * p * (1 - p) - e * p; return(list(dp)) })
}
library(deSolve)
p <- c(ci=.1, e=.01)
time <- 1:10
initialN <- .3
out <- ode(y=initialN, times=time, func=levins, parms=p)
plot(time, out[,-1], type='l')
 
 
Modelo de Gotelli
 
#ii) Gotelli. lluvia de propágulos o modelo isla-continente de Gotelli: dp/dt=ci*(1-p)-e*p los propáculos pueden venir de fuera de la colección de sitios que se monitorizan si la colección de sitios no está cerrada. Si asumimmos que la colección de sitios tiene lluvia continua de propáculso desde fuentes externas y solo estos propágulos son importantes, asumimos un flujo constante de propágulos que no dependen de la proporción p y la extinción solo es mediada por la proporción de sitios ocupados, y tiene una tasa constante por sitio.
gotelli <- function(t, y, parms) { p <- y[1]; with(as.list(parms), { dp <- ce * (1 - p) - e * p; return(list(dp)) }) }
 
Utilizando el paquete “deSolve” la simulación se reduce a:
#A function for the propagule rain or mainland-island metapopulation dynamics, for use with ode in the deSolve package.
function (t, y, parms)
{
p <- y[1]
with(as.list(parms), {dp <- ce * (1 - p) - e * p; return(list(dp))})
}
library(deSolve)
p <- c(ce=.1, e=.01)
time <- 1:10
initialN <- .3
out <- ode(y=initialN, times=time, func=gotelli, parms=p)
plot(time, out[,-1], type='l')
 
 
Modelo de Hanski
 
#iii) Hanski. modelo metapoblacional núcleo-satélite o de Hanski: dp/dt=ci*p*(1-p)-e*p*(1-p) (o re-arreglo dp/dt=(ci-e)*p*(1-p)), donde E=-e*p*(1-p) es la extinción total, con efecto rescate (efecto de la inmigración en la extinción) y asumimos que el suplemento de propágulos solo es interno.
hanski <- function(t, y, parms) { p <- y[1]; with(as.list(parms), { dp <- ci * p * (1 - p) - e * p * (1 - p); return(list(dp)) }) }
#gráfico del modelo de lluvia de propágulo y el modelo núcleo-satélite:
prms <- c(ci <- 0.15, ce <- 0.15, e = 0.05)
out.IMH <- data.frame(ode(y = Initial.p, times = 1:100, func = gotelli, parms = prms))
out.IMH[["pH"]] <- ode(y = Initial.p, times = 1:100, func = hanski, parms = prms)[, 2]
matplot(out.IMH[, 1], out.IMH[, 2:3], type = "l", col = 1, ylab = "p", xlab = "time"); legend("topleft", c("Hanski", "Propagule Rain"), lty = 2:1, bty = "n")
#estabilidad del crecimiento logístico: estudiamos la pendiente de la derivada parcial en el equilibrio respecto a o: deltap`/deltap=c-2*c*p-e+2*e*p donde p`es derivada del tiempo. Rearreglando vemos que deltap`/deltap=(ci-e)*(1-2*p). Estudiamos la estabilidad de un punto de equilibrio graficando la tasa de crecimiento como función de p.
dpdtCS <- expression((ci - e) * p * (1 - p)); ci <- 0.15; e <- 0.05; p <- seq(0, 1, length = 50); plot(p, eval(dpdtCS), type = "l", ylab = "dp/dt")
 
Utilizando el paquete “deSolve” la simulación se reduce a:
#A function for the core-satellite metaapopulation dynamics, for use with ode in the deSolve package.
prms <- c(ci<- 0.15, e=0.05)
out <- ode(y=.2, times=1:100, func=hanski, parms=prms )
matplot(out[,1], out[,2], type='l', ylab="p", xlab="time")
 
#Simulation of Stochastic Metapopulation Models: Originally focused on creating a community of core-satellite species, this function allows simulation of several metapopulation models, where colonization and extinction rates are stochastic draws from uniform distributions, with specified means and ranges.
out <- MetaSim(NSims=2)
pops <- out$Ns
matplot(out$t, pops, type='l')
title(sub=paste(out$method, "model"))
 
 
Modelo de Levins vs. Hanski
 
# Levins vs. Hanski. El modelo de Hanski puede cambiar gradualmente al modelo de Levins.
#sea el modelo de Hanski: dp/dt=ci*p*(1-p)-e*p*(1-ap), con a un parámetro extra. Bajo el modelo de Hanski a=1 y bajo el modelo de Levins a=0. Si resolvemos según el equilibrio, vemos que p´=(c-e)/(c-a*e). En el contexto del crecimiento logístico, donde K=H*p´, este p´implica que para el modelo de Hanski K llena todos los hábitat disponibles, mientras que en el modelo de Levins implica que K llena una fracción del hábitat total disponible. Esta fracción resulta del balance dinámica entre ci y e.
 
Modelo de destrucción del hábitat
 
#destrucción del hábitat (Lande, Kareiva & Wannergren): dp/dt=ci*p*(1-D-p)-ep, donde D es la cantidad o fracción de hábitat destruído y afecta la probabilidad de inmigración, y varía entre o (modelo de Levins) a 1 (pérdida total de hábitat).
library(deSolve); prmsD <- c(ci = 0.15, e = 0.05, D = 0); Ds <- c(0, 0.2, 0.5); Initial.p <- 0.01; t <- 1:200
ps <- sapply(Ds, function(d) { prmsD["D"] <- d; ode(y = Initial.p, times = t, func = lande, parms = prmsD)[, 2] })
matplot(t, ps, type = "l", ylab = "p", xlab = "time"); text(c(200, 200, 200), ps[200, ], paste("D = ", Ds, sep = ""), adj = c(1, 0))
p137(Stevens)
 
 
Utilizando el paquete “deSolve” la simulación se reduce a:
#Multi-species competition colonization model, with habitat destruction, after Nee and May (1992). For use with ode in the deSolve package.
library(deSolve)
S <- 10
ci <- 2^seq(-5, 5, length=S)
m <- rep(.1, S)
params <- list(ci=ci, m=m, S=S, D=0)
init.N <- rep(0.01, S); t=seq(1, 200, .1)
cc.out <- ode(init.N, t, compcolM, params)
matplot(t, cc.out[, -1], type="l", ylab="Proportion of Habitat", xlab="Years")
 
Utilizando el paquete “deSolve” la simulación se reduce a:
#A function for the metaapopulation dynamics, with habitat dsetruction. For use with ode in the deSolve package.
function (t, y, parms)
{
p <- y[1]
with(as.list(parms), {dp <- ci * p * (1 - D - p) - e * p; return(list(dp)) })
}
library(deSolve)
p <- c(ci=.1, e=.01, D=.5)
time <- 1:10
initialN <- .3
out <- ode(y=initialN, times=time, func=lande, parms=p)
plot(time, out[,-1], type='l')

Created by Pretty R at inside-R.org