jueves, 20 de enero de 2011

lunes, 17 de enero de 2011

domingo, 16 de enero de 2011

SJR - Country Search

SJR - Country Search: "- Enviado mediante la barra Google"

URUGUAY: http://www.scimagojr.com/countrysearch.php?country=UY
Read more...

SIR - SCImago Institutions Rankings

SIR - SCImago Institutions Rankings: "- Enviado mediante la barra Google"

Ver http://www.scimagoir.com/pdf/ranking_ibe_ciencias_vida.pdf
Read more...

miércoles, 12 de enero de 2011

Autómatas celulares (dinámica metapoblacional, sistema con competencia, sistema parásito-hospedero). Aplicación con R (paquete simecol)

Simulamos 3 casos: modelo metapoblacional (espacialmente implícito), modelo de competencia y modelo parásito-hospedero.

Modelo espacialmente implícito

#### Modelo espacialmente implícito: dinámica metapoblacional ##### producimos un dibujo con parches ocupados (color claro) y vacíos (color oscuro), de 10000 parches en un array de 100x100, pero el modelo no es espacialmente explícito, es solo una imagen. Las condiciones iniciales es de 100 parches ocupados aleatoriamente.
m=.15;e=.1;s=(1-e)
N<-matrix(rep(0,10000),nrow=100);xs<-sample(1:100);ys<-sample(1:100)
for (i in 1:100){N[xs[i],ys[i]]<-1 };image(1:100,1:100,N)
#queremos simulaciones de 1000 generaciones. Primero modelamos la supervivencia (o no) en parches ocupados. Cada celda en el universo toma un número aleatorio independiente desde una distribución uniforme (número real entre 0 y 1). Si el NA es <=s (=1-e) entonces el parche sobrevive otra generación. Si el NA es <s, el parche se extingue y N=0.
#calculamos la producción de propágulos (im) de los parches sobrevivientes. Asumimos que el asientamiento de los propágulos es aleatorio (caen en parches vacíos u ocupados).
for(t in 1:1000)
{
S <-matrix(runif(10000),nrow=100);N<-N*(S<s);
im<-floor(sum( N*m));placed<-matrix(sample(c(rep(1,im) ,rep (0,10000-im))),nrow=100)
N<-N+placed;N<-apply(N,2,function(x) ifelse(x>1,1,x)); image(1:100,1:100,N);box(col="red")
}
#como m>e la metapoblación persistirá. La solución analísitca a largo plazo es: 1-e/m=1-.1/.15/.333. En cualquier tiempo la proporción de ocupación actual es: sum(N)/length(N).


Modelo espacialmente explícito. Sistema de competencia (denso-dependencia local)

#### Modelo espacialmente explícito: DD local. competencia por sitios.
#Sean 2 especies que no pueden coexitir en un ambiente mezclado porque la fecundidad de la especie A es < que la fecundidad de la especie B, y esto conducirá tarde o temprano, en la exclusión competitiva de la especie B y la persistencia de la especie A. ej: insectos herbívoros o patógenos fúngicos.
#la sp B que se encuentra en la vecindad de la sp A impide el reclutamiento de la sp A cuando ésta se encuentra a más de un umbral T (individuos de sp A en el vecindario).
#idea: observar si la introducción de DD local en vecindario es suficiente para prevenir la exclusión competitiva y permitir la coexistencia a largo plazo de las 2 especies.
#bordes del universo:como todas las localizaciones neceitan tener el mismo número de vecinos en el modelo, utilizamos ‘wrap-around margins'
#definimos el vecindario, medinate una grilla cuadrada, una celda central y de 8 vecinos
plot(c(0,1),c(0,1),xaxt="n",yaxt="n",type="n",xlab="",ylab="");abline("v"=c(1/3,2/3));abline("h"=c(1/3,2/3))
xs<-c(.15,.5,.85,.15,.85,.15,.5,.85);ys<-c(.85,.85,.85,.5,.5,.15,.15,.15)
for (i in 1:8){ text(xs[i],ys[i],as.character(i)) }; text(.5,.5,"target cell")
#definimos los márgenes de las celdas. Sea el universo N de 100x100 celdas, la matriz de vecinos será de 102x102.
margins<-function(N)
{
edges<-matrix(rep(0,10404),nrow=102);edges[2:101,2:101]<-N;edges[1,2:101]<-N[100,];edges[102,2:101]<-N[1,];edges[2:101,1]<-N[,100]
edges[2:101,102]<-N[,1];edges[1,1]<-N[100,100];edges[102,102]<-N[1,1];edges[1,102]<-N[100,1];edges[102,1]<-N[1,100]
edges
}
#escribimos la funciónq ue cuenta el número de especies A en las 8 celdas vecinas de cada celda i,j:
nhood<-function(X,j,i) sum(X[(j-1):(j+1),(i-1):(i+1)]==1)
#seleccionamos los valores de los parámetros: tasa de reproducción de A y B, tasa de mortalidad de adultos y el número umbral T de especies A encima del cual no ocurre reclutamiento:
Ra<-3;Rb<-2.0;D<-0.25;s<-(1-D);T<-6
#condiciones iniciales: la mitad del universo con sp A y la otra mitad con sp. B
N<-matrix(c(rep(1,5000),rep(2,5000)),nrow=100);image(1:100,1:100,N)
#corremos la simulación 1000 pasos de tiempo
for (t in 1:1000)
{
S <-1*(matrix(runif(10000),nrow=100)<s) #para evaluar si un ocupante de una celda sobrevive o muere, comparamos un número aleatorio con distribución uniforme entre 0 y 1 con la tasa de sobrevivencia específica s=1-D. Si el NA<s el ocupante sobrevive, si NA>s muere.
N<-N*S; space<-10000-sum(S)
nt<-margins(N) # calculamos la densidad de vecindario de A para cada celda
tots<-matrix(rep(0,10000),nrow=100)
for (a in 2:101) {
for (b in 2:101) {
tots[a-1,b-1]<-nhood(nt,a,b)
}}
seedsA<- sum(N==1)*Ra; seedsB<- sum(N==2)*Rb #calculamos las semillas producidas por los sobrevivientes
all.seeds<-seedsA+seedsB; fA=seedsA/all.seeds; fB=1-fA
setA<-ceiling(10000*fA); placed<-matrix(sample(c(rep(1,setA) ,rep (2,10000-setA))),nrow=100) #las semillas se asientan aleatoriamente en el universo
#las semillas solo producen reclutas en celdas vacías (N[i,j]=0). Si el ganador de una celda vacía (placed) es la spB, toma la celda (if(placed[i,j]=2; N[i,j]<-2)). Si la spA gana la celda, necesitamos chequear que tiene <T vecinos de spA. Si lo hace la spA toma la celda. Si no lo hace la celda está dada a la spB (if(tots[i,j]>=T;N[i,j]<-2))
for (i in 1:100)
{
for(j in 1:100)
{
if(N[i,j] == 0 ){if(placed[i,j]== 2){N[i,j]<-2}} else {if(tots[i,j]>=T){N[i,j]<-2}else{N[i,j]<-1}}
}
}
image(1:100,1:100,N); box(col="red") #dibujamos el mapa de spA en rojo y spB en blanco
}
#observamos que la spA auemnta en frecuencia a expensas de la sp.B. Eventualmente, sin emberago, la spA llega al pto donde su vecindario tiene muchos indiv de la sp.A, y su reclutamiento comienza a fallar. En el equilibrio, la spB persiste en celdas aisladas o en parches pequeños.
#si T=9 la sp.A conduce a la extinción de la sp.B
#si T=0 la sp.B toma el espacio


Modelo espacialmente explícito. Sistema parásito-Hospedero

#### Modelo espacialmente explícito: parásito-huésped.
#La interacción es inestable en modelos no-espaciales, con oscilaciones que aqumentan conduciendo a la rápida extinción de la sp.huesped y luego a la sp.parásito.
#en modelos espaciales (con movimiento a las 8 celdas vecinas), la interacción produce bonitos patrones espaciales que fluctúan con la abundancia de las 2 spp.
#Modelo Nicholson-Bailey: función host para calcular la próxima población de hospedadores como función de el número actual de hospedadores y parásitos (N y P), y otra función parasite para calcular la p´roxima población de parásitos como función de N y P
################################################
##############################

#función de Nicholson-Bailey
host=function(N,P,r,a) N*exp(r-a*P)
parasite=function(N,P,a) N*(1-exp(-a*P))

#definiciones de los bordes
host.edges=function(N,Nrow)
{
Hedges=matrix(rep(0,(Nrow+2)^2),nrow=(Nrow+2))
Hedges[2:(Nrow+1),2:(Nrow+1)]=N
Hedges[1,2:(Nrow+1)]=N[Nrow,]
Hedges[(Nrow+2),2:(Nrow+1)]=N[1,]
Hedges[2:(Nrow+1),1]=N[,Nrow]
Hedges[2:(Nrow+1),(Nrow+2)]=N[,1]
Hedges[1,1]=N[Nrow,Nrow]
Hedges[(Nrow+2),(Nrow+2)]=N[1,1]
Hedges[1,(Nrow+2)]=N[Nrow,1]
Hedges[(Nrow+2),1]=N[1,Nrow]
Hedges
}

parasite.edges=function(P,Nrow)
{
Pedges=matrix(rep(0,(Nrow+2)^2),nrow=(Nrow+2))
Pedges[2:(Nrow+1),2:(Nrow+1)]=P
Pedges[1,2:(Nrow+1)]=P[Nrow,]
Pedges[(Nrow+2),2:(Nrow+1)]=P[1,]
Pedges[2:(Nrow+1),1]=P[,Nrow]
Pedges[2:(Nrow+1),(Nrow+2)]=P[,1]
Pedges[1,1]=P[Nrow,Nrow]
Pedges[(Nrow+2),(Nrow+2)]=P[1,1]
Pedges[1,(Nrow+2)]=P[Nrow,1]
Pedges[(Nrow+2),1]=P[1,Nrow]
Pedges
}
#función de vecindario
nhood=function(X,j,i) sum(X[(j-1):(j+1),(i-1):(i+1)])

#función de llegada de migrantes a cada celda
h.migration<-function(Hedges,Nrow) #The number of host migrants arriving in every cell is calculated as follows:
{
Hmigs<-matrix(rep(0,Nrow^2),nrow=Nrow)
for (a in 2:(Nrow+1))
{
for (b in 2:(Nrow+1))
{
Hmigs[a-1,b-1]<-nhood(Hedges,a,b)
}
}
Hmigs
}

p.migration<-function(Pedges,Nrow) # The number of parasites migrants is given by:
{
Pmigs<-matrix(rep(0,Nrow^2),nrow=Nrow)
for (a in 2:(Nrow+1))
{
for (b in 2:(Nrow+1))
{
Pmigs[a-1,b-1]<-nhood(Pedges,a,b)
}
}
Pmigs
}
##############################

parasito_hospedero<-function(Tiempo=100,Xinitial=33,Yinitial=33,Nrow=100,NN=2,NP=2,r=.4,a=.1,Hmr=.1,Pmr=.9)
{

##seleccionamos los valores de los parámetros: dinámicas del hospedador (r) y parásito (r), tasas de migración Hmr y Pmr: en este caso los hospedadores son relativamente sedentarios y el parásito es altamente móvil
N=matrix(rep(0,Nrow^2),nrow=Nrow) #matrices de abundancias del hospedador (N) y el parásito (P)
P=matrix(rep(0,Nrow^2),nrow=Nrow)
N[Xinitial,Yinitial]=NN #condiciones iniciales 200 hospedadores y Nrow parásitos en una única calda de localización (33,33)
P[Xinitial,Yinitial]=NP
Nt<-NN;Pt<-NP
par(mfrow=c(2,1)); image(N+P) #eliminar si deseo obtener solo el gráfico de Nt y Pt vs tiempo
plot(NN~1, xlim=c(0,Tiempo),ylim=c(0,NN*2),pch=20,col="red"); points(NP~1,pch=20,col="blue")
for (t in 2:Tiempo) #The simulation begins here, and runs for 600 generations:
{
he<-host.edges(N,Nrow=Nrow)
pe<-parasite.edges(P,Nrow=Nrow)
Hmigs<-h.migration(he,Nrow=Nrow)
Pmigs<-p.migration(pe,Nrow=Nrow)
N<-N-Hmr*N+Hmr*Hmigs/9
P<-P-Pmr*P+Pmr*Pmigs/9
Ni<-host(N,P,r,a)
P<-parasite(N,P,a)
N<-Ni
Nt<-c(Nt,sum(N))
Pt<-c(Pt,sum(P))
image(N+P); TT<-1:t;plot((Nt/100)~TT,xlim=c(0,Tiempo),ylim=c(0,NN*2),pch=20,type="o",col="red");points((Pt/100)~TT,pch=20,type="o",col="blue") #eliminar si deseo obtener solo el gráfico de Nt y Pt vs tiempo
#image(1:Nrow,1:Nrow,N)
#TT<-1:t;points((Nt/100)~TT,pch=20,type="o",col="red");points((Pt/100)~TT,pch=20,type="o",col="blue") #agregar si deseo obtener el gráfico de Nt y Pt vs Tiempo
}
out<-list(Hospederos=Nt,Parasitos=Pt)
out
}

datos<-parasito_hospedero(Tiempo=100,Xinitial=33,Yinitial=33,Nrow=100,NN=200, NP=100, r=.4,a=.1,Hmr=.1,Pmr=.9) #es el ejemplo del libro "R book"
datos

Read more...

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

Read more...

Libros para descargar (gratis)