====== Exercício V - Tabelas de Vida ====== **Objetivos:**\\ Montar uma tabela de vida para a população de uma espécie que contenha as seguintes informações:\\ * **x**: Número de classes etárias da população;\\ * **Sx**: Número de indivíduos em cada classe etária da população;\\ * **bx**: Perfil de fecundidade da população;\\ * **lx**: Perfil de sobrevivência da população;\\ * **gx**: Probabilidade de sobrevivência;\\ * Produto entre **lx** e **bx**;\\ * Produto entre **lx**, **bx** e **x**;\\ * ''(exp(-r*x))*lx*bx'' (ver equação 3.6, pp. 59); * ''(exp(-r*x))*ly*by'' (ver equação 3.12, pp. 65); Ao final, nós vamos calcular a partir da tabela de vida, a taxa líquida de reprodução (**Ro**), o tempo de geração (**G**), uma aproximação da taxa intrínseca de crescimento (**r**), o r de Euler (**re**) e o valor reprodutivo (**vx**). Além disso, vamos obter uma representação gráfica do perfil de sobrevivência em função das classes etárias.\\ * 1 Estabeleça os valores de **Sx** e **bx**, para que você possa ir testando a sua função.\\ Sx<-c(1000,300,200,120,50,0) bx<-c(0,2,4,3,1,0) * 2. Chame sua função de ''tab.vida''. Lembre-se de que todos os parâmetros da tabela de vida são calculados a partir de **Sx** e **bx**. * 3. Garanta que **Sx** e **bx** tenham o mesmo comprimento. Use o seguinte comando: if (length(Sx)!=length(bx)) { stop("Erro !! Sx e bx têm comprimentos diferentes") } * 4. Calcule o número de classes etárias da população (no caso ''nclass=length(Sx)''). * 5. Estruturar a matriz de tabela de vida. * 5.1. Crie um índice para guardar o número de classes etárias da população. Em seguida, declare um vetor correspondente às idades da população. * 5.2. Monte a estrutura da tabela de vida. Ela deve ser preenchida por zeros ter nove colunas (uma para cada parâmetro da tabela de vida, ver exemplo no Gotelli (2007), pp. 65, tabela 3.3) e o número de linhas equivalente ao número de valores de **Sx**. * 5.3. Agora nomeie as colunas da tabela de vida. * 5.4. Coloque as idades na primeira coluna . nclass=length(Sx) resulta=matrix(0, nrow=nclass, ncol=9) colnames(resulta)<-c("x","S(x)", "b(x)","l(x)","g(x)","l(x)b(x)","l(x)b(x)x", "init.est", "correct.est") * 5.5. Guarde os valores de sobrevivência da coorte **Sx** na segunda coluna .\\ * 5.6. Guarde os valores de fecundidade **bx** na terceira coluna .\\ * 5.7. Calcule os perfis de sobrevivência **lx** e guarde-os na quarta coluna de **resulta**. Lembre-se que **lx** é dado pelo quociente de Sx com o valor de Sx da primeira classe etária. * 5.8. Calcule a probabilidade de sobrevivência por idade **gx** e guarde na quinta coluna . Lembrem-se que a probabilidade de sobrevivência vai até a penúltima classe etária (dica:'' gx=lx[2:nclas]/lx[1:(nclass-1)]''). * 5.9. Calcule o produto de **lx** e **bx** (medida de contribuição da reprodução, levando em conta a sobrevivência dos indivíduos em cada idade) e guarde na sexta coluna. * 5.10. Calcule o produto entre **lx**, **bx** e a **idade(//xi//)** e guarde na sétima coluna. * 6. Agora, vamos calcular a taxa líquida de reprodução **Ro**, definida como o número médio de fêmeas produzidas por uma fêmea ao longo de toda sua vida. O **Ro** é dado pelo somatório dos produtos entre **lx** e **bx**. * 6.1. Use o comando ''cat'' para mostar o valor de **Ro** na tela. * 7. Calcule o tempo de geração **G**. O tempo de geração é a média das idades dos progenitores de todos os descendentes produzidos por uma coorte. Veja a equação 3.4, da página 58 do Gotelli (2007). * 7.1. Use o comando ''cat'' para imprimir o valor de **G**.\\ * 8. Vamos calcular agora uma aproximação da taxa intrínseca de crescimento, o **r.est**. Veja a equação 3.5 (//r.est=ln(Ro)/G//) da página 58 do Gotelli (2007). * 8.1. Use o comando ''cat'' para imprimir o valor aproximado de **r.est**.\\ * 9 Use as seguintes linhas de comando para calcular o r exato pelo equação de Euler: resulta[,"init.est"]<-round(exp(-r.est*resulta[,"x"])*resulta[,"l(x)"]*resulta[,"b(x)"],3) euler<-numeric(0) try.r<-seq(r.est-0.2*r.est,r.est+0.2*r.est,0.0001)''\\ for(i in 1:length(try.r) ) { euler[i]<-sum(exp(-try.r[i]*resulta[,"x"])*resulta[,"l(x)b(x)"])''\\ } r.eule<-try.r[which(round(euler,3)==1.000)] r.euler<-r.eule[floor(length(r.eule)/2)] eq.euler<-euler[which(try.r==r.euler)] resulta[,"correct.est"]<-round(exp(-r.euler*TABVIDA[,"x"])*TABVIDA[,"l(x)b(x)"],3)''\\ cat(paste("r estimado =", round(r.est,4)), "\n") cat(paste("Correção adicionada ao r estimado =", round(r.euler-r.est,4)), "\n") cat(paste("r de Euler =", round(r.euler,4),"Eq Euler=",round(eq.euler,5)),"\n") * 10. Use as linhas de comando abaixo para calcular o valor reprodutivo (vx) e mostrá-los na tela: vr=rep(0, nclass) e1=exp(r.euler*resulta[,"x"])/resulta[,"l(x)"] e2= exp(-r.euler * resulta[,"x"]) * resulta[,"l(x)b(x)"] for(i in 1:(nclass-1)) { vr[i]= e1[i] * sum(e2[(i+1):nclass]) } cat("\n Valor Reprodutivo \n\t", paste("clas.etaria", 1:nclass, "=", round(vr, 4), "\n\t")) * 11. Faça uma representação gráfica da sobrevivência (**lx**) em função das idades (**x**).\\ plot(resulta[,1],resulta[,4],type="l",lty=2,col="blue",xlab="idade(x)",ylab="sobrevivência l(x)")''\\ * 12. Peça para retornar os valores de **resulta**.\\ * 13. Teste a função **tab.vida** com os valores de Sx e bx do exemplo do Gotelli (tabela 3.1, pag. 52) e confirme se sua função fez os cálculos corretamente (vr na tabela 3.3 pag. 65). Sx=c(500,400,200,50,0) bx=c(0,2,3,1,0) tab.vida(Sx,bx) * 14. Verifique as variações no resultado da tabela de vida conforme varia os parâmetros Sx e bx. Interprete! ----