Asignatura Biogeografía, GEO131, UASD, semestre 2016-02. Prácticas 11. Análisis de correlación y regresion linea univariada con R

BIO-131 SEM-2016-02 Practica 11.R

###INICIO VIDEO: https://www.youtube.com/watch?v=GrSRoZHDI6A
###LISTA DE REPRODUCCION: https://www.youtube.com/watch?v=8uHnf_1W7D8&list=PLDcT2n8UzsCTkT7Ylgjll5Zxyrj30_lc1
#ANALISIS DE CORRELACION Y REGRESION UNIVARIADA

#FIJAR EL DIRECTORIO DE TRABAJO TEMPORAL
setwd(tempdir())

#LECTURA DE DATOS FUENTE DE INDIVIDUOS DE Anolis distichus, DE LISSETTE RODRIGUEZ, CAMPUS UASD
d <- read.csv('http://www.geografiafisica.org/sem_2016_02/geo131/datos/alumnas/datos%20de%20campo%20todos.csv')
d$Q <- factor(d$Q)

#QUADRATS
download.file('http://www.geografiafisica.org/sem_2016_02/geo131/gis/UASD/quadrats/quadrats.zip', 'quadrats.zip')
unzip('quadrats.zip')

#LECTURA DE TABLA DE PORCENTAJES DE COBERTURAS POR QUADRATS
require(foreign)
qpc <- read.dbf('c50mpctgrp.dbf')
head(qpc)
qpc$layer
qpc$layer <- factor(qpc$layer)
qpc$layer

#TABLA DE ABUNDANCIA
tabun <- as.data.frame.table(table(d$Q))
tabun
colnames(tabun) <- c('layer','ABUN')
tabun

#UNION CON TABLA DE PORCENTAJES DE COBERTURAS POR QUADRATS
qpcl <- merge(qpc,tabun)
qpcl

#CORRELACION Y REGRESION
#DOSE Y ABUN
dev.new();dev.new();with(qpcl, plot(DOSE,ABUN))
dev.new();par(mfrow=c(1,2)); sapply(c('DOSE','ABUN'), function(x) hist(qpcl[,x], main=x))
dev.new();par(mfrow=c(1,2)); sapply(c('DOSE','ABUN'), function(x) qqnorm(qpcl[,x], main=x))
sapply(c('DOSE','ABUN'), function(x) shapiro.test(qpcl[,x])) #ABUN NO PROVIENE DE POBLACION CON DISTRIBUCION NORMAL
with(qpcl, cor.test(DOSE,ABUN, method = 'spearman', exact = F))
#REGRESION
mad <- lm(ABUN~DOSE, qpcl)
summary(mad)
madc <- round(coef(mad),2)
madc
#GRAFICO
dev.new();with(qpcl, plot(DOSE,ABUN))
abline(mad)
eqad <- paste0('ABUN = ', madc[1], " + ", madc[2], " DOSE")
mtext(eqad, line = -3, cex = 1.5, col = 'grey')

#SIN OUTLIERS
dev.new();par(mfrow=c(1,2)); sapply(c('DOSE','ABUN'), function(x) boxplot(qpcl[,x], main=x))
abunout <- boxplot(qpcl$ABUN, plot = F)$out #OUTLIERS
abunout
sort(qpcl$ABUN)
qpclso <- qpcl[!qpcl$ABUN %in% abunout,]
qpclso
sapply(c('DOSE','ABUN'), function(x) shapiro.test(qpclso[,x])) # EXCLUYENDO OUTLIERS, ABUN NO PROVIENE DE POBLACION CON DISTRIBUCION NORMAL
with(qpclso, cor.test(DOSE,ABUN, method = 'spearman', exact = F))
#REGRESION
madso <- lm(ABUN~DOSE, qpclso)
summary(madso) #COMPARAR CON summary(mad)
madcso <- round(coef(madso),2)
madcso
#GRAFICO
dev.new();with(qpclso, plot(DOSE,ABUN))
abline(madso)
eqadso <- paste0('ABUN = ', madcso[1], " + ", madcso[2], " DOSE")
mtext(eqadso, line = -3, cex = 1.5, col = 'grey')

#ABUN CON CADA UNA DE LAS DEMAS VARIABLES
dev.new();with(qpcl, plot(SUEL,ABUN))
sapply(c('SUEL','EDIF','CONS'), function(x) cor.test(qpcl[,x],qpcl[,'ABUN'], method = 'spearman', exact = F))

#ABUN CON TODAS LAS DEMAS VARIABLES SIN OUTLIERS
sapply(c('SUEL','EDIF','CONS'), function(x) cor.test(qpclso[,x],qpclso[,'ABUN'], method = 'spearman', exact = F))
sapply(paste0('ABUN~', c('SUEL','EDIF','CONS')), function(x) summary(lm(as.formula(x), qpclso)), simplify = F)

#ELIGIENDO CONS
#REGRESION
macso <- lm(ABUN~CONS, qpclso)
summary(macso)
maccso <- round(coef(macso),2)
maccso
#GRAFICO
dev.new();with(qpclso, plot(CONS,ABUN))
abline(macso)
eqacso <- paste0('ABUN = ', maccso[1], " + ", maccso[2], " CONS")
mtext(eqacso, line = -3, cex = 1.5, col = 'grey')

#PREDICCION
sort(qpclso$CONS)
summary(qpclso$CONS)
nuevo <- data.frame(CONS=c(0,50, 100))
nuevo
PRED <- round(predict(macso, nuevo),0)
PRED
nuevopred <- cbind(nuevo, PRED)
nuevopred
###FIN VIDEO