TCC CE 229
++++ Códigos |
## Carregando arquivos necessários
cat("Carregando Arquivos Necessários\n")
library(aRT)
library(geoR)
source('datachk.R')
######### Parte 1
codbairro <- list(BT=94, CFP=c(54,55), DI=c(39,40), EM=73, MCP=c(51,52))
aed <- datachk(host="guaja.est.ufpr.br", pass="wbhdpj", codBairros = codbairro)
summary(aed$dados)
######### Parte 2
dad.cara <- getData(openTable(la,"CARACTERISTICAS_LUGAR"))
#########TIPO DE IMOVEL###################
## RCS RAP RCM == 0
## QRT ESC IGR Outros == 1
## SI == NA
dad.cara$TIPO_IMOVEL[dad.cara$TIPO_IMOVEL %in% c("RCS", "RAP", "RCM")] <- 0
dad.cara$TIPO_IMOVEL[dad.cara$TIPO_IMOVEL %in% c("QRT", "ESC", "IGR", "Outros")] <- 1
dad.cara$TIPO_IMOVEL[dad.cara$TIPO_IMOVEL == "SI"] <- NA
#table(dad.cara$TIPO_IMOVEL)
############PRESENÇA DE QUINTAL###########
## Sim == 0
## Não == 1
## SI == NA
dad.cara$QUINTAL[dad.cara$QUINTAL == "Sim"] <- 0
dad.cara$QUINTAL[dad.cara$QUINTAL == "Não"] <- 1
dad.cara$QUINTAL[dad.cara$QUINTAL == "SI"] <- NA
#table(dad.cara$QUINTAL)
#########PRESENÇA DE JARDIM COM SOMBRA#############
## Sim == 0
## Não == 1
## NA SI == NA
dad.cara$SOMBRA[dad.cara$SOMBRA == "Sim"] <- 0
dad.cara$SOMBRA[dad.cara$SOMBRA == "Não"] <- 1
dad.cara$SOMBRA[!dad.cara$SOMBRA %in% 0:1] <- NA
#table(dad.cara$SOMBRA)
########AGUA LIGADA A REDE GERAL ###########
dad.cara$AGUA_REDE[dad.cara$AGUA_REDE == "Sim"] <- 0
dad.cara$AGUA_REDE[dad.cara$AGUA_REDE == "Não"] <- 1
dad.cara$AGUA_REDE[dad.cara$AGUA_REDE == "SI"] <- NA
#table(dad.cara$AGUA_REDE)
#######FREQUENCIA DE ABASTECIMENTO DE AGUA ############
## Diaria D == 0
## Dois em dois dias DD ou mais == 1
## NA e SI == NA
dad.cara$FREQ_ABASTECIMENTO[!dad.cara$FREQ_ABASTECIMENTO %in% c("D", "SI", NA)] <- 1
dad.cara$FREQ_ABASTECIMENTO[dad.cara$FREQ_ABASTECIMENTO == "D"] <- 0
dad.cara$FREQ_ABASTECIMENTO[dad.cara$FREQ_ABASTECIMENTO == "SI"] <- NA
#table(dad.cara$FREQ_ABASTECIMENTO)
###########AGUA CANALIZADA################
dad.cara$CANALIZADA_COMODO[dad.cara$CANALIZADA_COMODO == "Sim"] <- 0
dad.cara$CANALIZADA_COMODO[dad.cara$CANALIZADA_COMODO == "Não"] <- 1
dad.cara$CANALIZADA_COMODO[dad.cara$CANALIZADA_COMODO == "SI"] <- NA
#table(dad.cara$CANALIZADA_COMODO)
######### FREQUENCIA DA COLETA DE LIXO #############
dad.cara$FREQUENCIA_COLETA[dad.cara$FREQUENCIA_COLETA == "D"] <- 0
dad.cara$FREQUENCIA_COLETA[dad.cara$FREQUENCIA_COLETA %in% c("DD", "DDD", "DDDD")] <- 1
dad.cara$FREQUENCIA_COLETA[dad.cara$FREQUENCIA_COLETA %in% c("ENT", "QMD", "OUTR")] <- 2
dad.cara$FREQUENCIA_COLETA[dad.cara$FREQUENCIA_COLETA== "SI"] <- NA
#table(dad.cara$FREQUENCIA_COLETA)
########PRESENÇA DE RESERVATÓRIOS #############
names(dad.cara[,c(20:32)])
sapply(dad.cara[,c(20:32)],class)
dad.cara$res.grd.sem <- apply(dad.cara[,c(20,21,22,24,26)],1,sum)
dad.cara$res.grd.com <- apply(dad.cara[,c(23,25,27)],1,sum)
dad.cara$res.peq.sem <- apply(dad.cara[,c(28,30)],1,sum)
dad.cara$res.peq.com <- apply(dad.cara[,c(29,31)],1,sum)
#### Recipiente grande sem tampa
dad.cara$res.grd.sem[dad.cara$res.grd.sem >= 1] <- 1
dad.cara$res.grd.com[dad.cara$res.grd.com >= 1] <- 1
dad.cara$res.peq.sem[dad.cara$res.peq.sem >= 1] <- 1
dad.cara$res.peq.com[dad.cara$res.peq.com >= 1] <- 1
summary(dad.cara)
## Reservatorios pqnos, somando td que for sim
vars <- c("PLTV", "CHCP", "GRF", "FOSS", "PISC", "PCEL", "LJST", "CALH")
#Substituindo "SI" por NA
sapply(dad.cara[vars], function(x)dad.cara[x=="SI",vars] <<- NA)
# Substituindo os Níveis
test <- as.data.frame(sapply(dad.cara[vars], factor))
sapply(names(test), function(x)levels(test[,x])<<- 0:1)
test <- sapply(test, function(x)as.numeric(as.character(x)))
## Criando A Variavel com reservatorios pqnos
res.pq <- rowSums(test, na.rm = T)
res.pq[res.pq >= 1] <- 1
dados <-with(dad.cara, data.frame(COD_ARMADILHA, TIPO_IMOVEL=factor(TIPO_IMOVEL),NRO_RESIDENTES,
QUINTAL=factor(QUINTAL),SOMBRA=factor(SOMBRA),
res.pq=factor(res.pq),AGUA_REDE=factor(AGUA_REDE),
FREQ_ABASTECIMENTO=factor(FREQ_ABASTECIMENTO),
CANALIZADA_COMODO=factor(CANALIZADA_COMODO),
res.grd.sem=factor(res.grd.sem),res.grd.com=factor(res.grd.com),
res.peq.sem=factor(res.peq.sem),res.peq.com=factor(res.peq.com),
FREQUENCIA_COLETA=factor(FREQUENCIA_COLETA)))
covaria <- merge(dados, aed$dados, by.x="COD_ARMADILHA", by.y="COD_ARMADILHA")
################## Parte 3
## Metereologicas
##
fonte <- getData(openTable(openLayer(db, 'estacoes'), 'estacoes'))
obs <- getData(openTable(openLayer(db, 'estacoes'), 'OBS_METEOROLOGICAS'))
clima <- merge(fonte, obs)
head(aed$dados)
head(covaria)
head(fonte)
head(obs)
## Excluindo o ano de 2004 por falta de obs. meteorologicas
covaria <- covaria[format(covaria$DATA_COLETA, "%Y") > 2004,]
covaria <- covaria[order(covaria$DATA_COLETA),]
summary(covaria)
# Transformando pra DATA
clima$DATA_OBS <- as.Date(clima$DATA_OBS)
clima <- clima[order(clima$DATA_OBS),]
newobs <- clima[!duplicated(clima$DATA_OBS),]
names(clima)
teste <- merge(clima,covaria,by.x=c("SITIO","DATA_OBS"),by.y=c("BAIRRO","DATA_COLETA"))
dados.split <- lapply(split(teste, teste$SITIO), function(x)split(x, x$DATA_OBS))
## Datas 27 periodos anteriores
dados.Datas <- lapply(dados.split,
function(elem) # Bairros
lapply(elem,
function(dat) # Datas de dados.split
merge(data.frame(DATA_COLETA = unique(dat$DATA_OBS) - 1:83,
BAIRRO = unique(dat$SITIO)), clima,
by.x = c("DATA_COLETA", "BAIRRO"),
by.y = c("DATA_OBS", "SITIO"), sort = FALSE)))
out <- lapply(dados.Datas,
function(bairro)
lapply(bairro,
function(datas)
lapply(c("TEMP_MAXIMA",
"TEMP_MINIMA",
"UMIDADE_RELATIVA",
"PRECIPITACAO"),
function(form)
tapply(datas[,form], datas[, "DATA_COLETA"], mean, na.rm = T))))
out1 <- lapply(out,
function(bairro)
lapply(bairro,
function(datas)
matrix(t(sapply(datas, c)), nrow = 1)))
teste.ok <- do.call(rbind, lapply(lapply(names(dados.split),
function(bairro)
lapply(names(dados.split[[bairro]]),
function(datas)
cbind(
dados.split[[bairro]][[datas]],
do.call(rbind, rep(list(out1[[bairro]][[datas]]), nrow(dados.split[[bairro]][[datas]])))
))),
function(bairros)do.call(rbind, bairros)))
## Ordenando a 'criança'
names(teste.ok)[25:356] <- paste(rep(c("MAX", "MIN", "UMID", "PRECI"), 83), rep(1:83, each = 4), sep=".")
teste.ok <- teste.ok[,c(1:24, 356:25)]
# Adicionando as Coordenadas
dados <- merge(teste.ok,
as.data.frame(aed$pts)[c(1, 5:6)],
by.x = "COD_ARMADILHA", by.y = "ID", sort = FALSE)
names(dados)
dados <- dados[,c(1:5, 9,8,7,6, 10:358)]
##Tirando as 'média' de 7 em 7
cols <- grep("TEMP|UMIDADE|PRECIPITACAO|MAX|MIN|UMID|PRECI",
names(dados), value = T)
precip <- split(seq(1, 336, by=4), rep(1:12, each = 7))
dados <- data.frame(dados, as.data.frame(lapply(precip,
function(pos)
rowMeans(dados[,cols[pos]], na.rm = TRUE)
)))
names(dados)[(ncol(dados)-11):ncol(dados)] <- paste("PRECIPM", 1:12, sep=".")
umid <- split(seq(2, 336, by=4), rep(1:12, each = 7))
dados<- cbind(dados, lapply(umid,
function(pos)
rowMeans(dados[,cols[pos]], na.rm = TRUE)
))
names(dados)[(ncol(dados)-11):ncol(dados)] <- paste("UMIDM", 1:12, sep=".")
minimo <- split(seq(3, 336, by=4), rep(1:12, each = 7))
dados<- cbind(dados, lapply(minimo,
function(pos)
rowMeans(dados[,cols[pos]], na.rm = TRUE)
))
names(dados)[(ncol(dados)-11):ncol(dados)] <- paste("MINM", 1:12, sep=".")
maximo <- split(seq(4, 336, by=4), rep(1:12, each = 7))
dados <- cbind(dados, lapply(maximo,
function(pos)
rowMeans(dados[,cols[pos]], na.rm = TRUE)
))
names(dados)[(ncol(dados)-11):ncol(dados)] <- paste("MAXM", 1:12, sep=".")
dados1 <- dados[,
c("DATA_OBS", #Data da Observacao
"TIPO_IMOVEL", #Tipo da Residencia
"QUINTAL", #Tem Quintal
"SOMBRA", #SOMBRA
"res.pq", #reservatorios pequenos
"AGUA_REDE", #AGUA Canalizada
"FREQ_ABASTECIMENTO", #Freq. Abast
"CANALIZADA_COMODO", #Canalizada
"res.grd.com",
"res.grd.sem",
"res.peq.com",
"res.peq.sem",
"NRO_OVOS",
"GRUPO",
"SITIO",
paste("PRECIPM", 1:12, sep = "."),
paste("UMIDM", 1:12, sep = "."),
paste("MINM", 1:12, sep = "."),
paste("MAXM", 1:12, sep = "."),
"coords.x1", "coords.x2", "COD_ARMADILHA")]
######## Arrumando os NA's provisoriamente #############
#--------------------------------------------------------
summary(dados1$TIPO_IMOVEL)
## Assumindo que os NA's são Imóveis Residênciais == 0
dados1$TIPO_IMOVEL[is.na(dados1$TIPO_IMOVEL)] <- 0
#--------------------------------------------------------
summary(dados1$QUINTAL)
## Assumindo que os NA's tem QUINTAl
dados1$QUINTAL[is.na(dados1$QUINTAL)] <- 0
#--------------------------------------------------------
summary(dados1$SOMBRA)
## Estamos desconsiderando a Sombra devido ao alto número de NA's
#--------------------------------------------------------
summary(dados1$AGUA_REDE)
## Assumindo que os NA's pertencem a classe 1
dados1$AGUA_REDE[is.na(dados1$AGUA_REDE)] <- 1
#--------------------------------------------------------
summary(dados1$FREQ_ABASTECIMENTO)
## Assumindo que NA's pertencem à classe 0
dados1$FREQ_ABASTECIMENTO[is.na(dados1$FREQ_ABASTECIMENTO)] <- 0
#--------------------------------------------------------
summary(dados1$CANALIZADA_COMODO)
## Assumindo que NA's pertencem à classe 1
dados1$CANALIZADA_COMODO[is.na(dados1$CANALIZADA_COMODO)] <- 1
#--------------------------------------------------------
sapply(grep("PRECIPM", names(dados1), value = T),
function(x)dados1[[x]][is.na(dados1[[x]])] <<-
mean(unique(dados1[[x]])[which(is.na(unique(dados1[[x]]))) - 1:2]))
sink("ultimate.txt")
cat("dados <- ")
dput(dados1)
sink()
++++
Verificando a relação entre as covariáves
Carregando os dados:
source("http://leg.ufpr.br/~henrique/dengue/ultimate.txt")
- ++ Matrix de Correlações para Precipitacao:
cor(dados[grep("PRECIPM", names(dados), value = TRUE)])
PRECIPM.1 PRECIPM.2 PRECIPM.3 PRECIPM.4 PRECIPM.5 PRECIPM.6 PRECIPM.7 PRECIPM.8 PRECIPM.9 PRECIPM.10 PRECIPM.11 PRECIPM.12 PRECIPM.1 1.000000000 0.398375874 0.057277885 0.013834372 0.007848884 0.003618893 0.006761595 0.023278240 -0.010632712 -0.01930623 -0.01681982 -0.02477457 PRECIPM.2 0.398375874 1.000000000 0.404389898 0.046810347 0.027555023 0.005415886 -0.004140145 0.009094026 0.020210220 -0.01420307 -0.02371912 -0.02057449 PRECIPM.3 0.057277885 0.404389898 1.000000000 0.387334703 0.082684242 0.034207590 0.006265112 0.001249893 0.011982131 0.01957621 -0.01420898 -0.02087694 PRECIPM.4 0.013834372 0.046810347 0.387334703 1.000000000 0.513097133 0.072394221 0.029946494 0.010733731 0.002181328 0.01371130 0.02106778 -0.01286263 PRECIPM.5 0.007848884 0.027555023 0.082684242 0.513097133 1.000000000 0.370619857 0.112385302 0.061829845 0.033919315 0.02094136 0.02900616 0.01741112 PRECIPM.6 0.003618893 0.005415886 0.034207590 0.072394221 0.370619857 1.000000000 0.409524763 0.125485080 0.074845352 0.04265303 0.02210106 0.02639234 PRECIPM.7 0.006761595 -0.004140145 0.006265112 0.029946494 0.112385302 0.409524763 1.000000000 0.429668727 0.127442259 0.07058439 0.03668875 0.02274303 PRECIPM.8 0.023278240 0.009094026 0.001249893 0.010733731 0.061829845 0.125485080 0.429668727 1.000000000 0.433147910 0.12696228 0.06808068 0.04234298 PRECIPM.9 -0.010632712 0.020210220 0.011982131 0.002181328 0.033919315 0.074845352 0.127442259 0.433147910 1.000000000 0.41050226 0.13151447 0.07812738 PRECIPM.10 -0.019306227 -0.014203072 0.019576207 0.013711302 0.020941359 0.042653031 0.070584391 0.126962281 0.410502255 1.00000000 0.41361157 0.13306355 PRECIPM.11 -0.016819816 -0.023719117 -0.014208984 0.021067781 0.029006165 0.022101056 0.036688746 0.068080676 0.131514465 0.41361157 1.00000000 0.43382189 PRECIPM.12 -0.024774573 -0.020574488 -0.020876940 -0.012862630 0.017411118 0.026392344 0.022743026 0.042342985 0.078127385 0.13306355 0.43382189 1.00000000
- Gráfico de Dispersão para Precipitação x Ovos
++
- Matrix de Correlações para Umidade:
cor(dados[grep("UMIDM", names(dados), value = TRUE)])
UMIDM.1 UMIDM.2 UMIDM.3 UMIDM.4 UMIDM.5 UMIDM.6 UMIDM.7 UMIDM.8 UMIDM.9 UMIDM.10 UMIDM.11 UMIDM.12 UMIDM.1 1.0000000 0.8136284 0.7237655 0.6373399 0.5910477 0.5412617 0.5126541 0.4435200 0.3522417 0.2641260 0.1996885 0.1380407 UMIDM.2 0.8136284 1.0000000 0.8207516 0.7312642 0.6493093 0.5976661 0.5427578 0.5198054 0.4425611 0.3689211 0.2761524 0.2117798 UMIDM.3 0.7237655 0.8207516 1.0000000 0.8208429 0.7376715 0.6578395 0.6062644 0.5495746 0.5126250 0.4484363 0.3730241 0.2825577 UMIDM.4 0.6373399 0.7312642 0.8208429 1.0000000 0.8238597 0.7416904 0.6662030 0.6135283 0.5459471 0.5225217 0.4613921 0.3798243 UMIDM.5 0.5910477 0.6493093 0.7376715 0.8238597 1.0000000 0.8268156 0.7576003 0.6737215 0.6174664 0.5603879 0.5389428 0.4682084 UMIDM.6 0.5412617 0.5976661 0.6578395 0.7416904 0.8268156 1.0000000 0.8321702 0.7627082 0.6765630 0.6247809 0.5680300 0.5416232 UMIDM.7 0.5126541 0.5427578 0.6062644 0.6662030 0.7576003 0.8321702 1.0000000 0.8306684 0.7587407 0.6813222 0.6264243 0.5698501 UMIDM.8 0.4435200 0.5198054 0.5495746 0.6135283 0.6737215 0.7627082 0.8306684 1.0000000 0.8321120 0.7640257 0.6843983 0.6267866 UMIDM.9 0.3522417 0.4425611 0.5126250 0.5459471 0.6174664 0.6765630 0.7587407 0.8321120 1.0000000 0.8336239 0.7675529 0.6852552 UMIDM.10 0.2641260 0.3689211 0.4484363 0.5225217 0.5603879 0.6247809 0.6813222 0.7640257 0.8336239 1.0000000 0.8360349 0.7685041 UMIDM.11 0.1996885 0.2761524 0.3730241 0.4613921 0.5389428 0.5680300 0.6264243 0.6843983 0.7675529 0.8360349 1.0000000 0.8367102 UMIDM.12 0.1380407 0.2117798 0.2825577 0.3798243 0.4682084 0.5416232 0.5698501 0.6267866 0.6852552 0.7685041 0.8367102 1.0000000
- Gráfico para Umidade x Nro Ovos
- Matrix de Correlações para Temperatura Máxima:
cor(dados[grep("MAXM", names(dados), value = TRUE)])
MAXM.1 MAXM.2 MAXM.3 MAXM.4 MAXM.5 MAXM.6 MAXM.7 MAXM.8 MAXM.9 MAXM.10 MAXM.11 MAXM.12 MAXM.1 1.0000000 0.8873240 0.8242368 0.7845877 0.7219937 0.6613631 0.6088920 0.5441925 0.4661010 0.3681705 0.2635478 0.1855049 MAXM.2 0.8873240 1.0000000 0.8896875 0.8280014 0.7932665 0.7261528 0.6602437 0.6102810 0.5434943 0.4660501 0.3594969 0.2606314 MAXM.3 0.8242368 0.8896875 1.0000000 0.8891065 0.8328116 0.7990354 0.7329438 0.6642783 0.6152469 0.5489423 0.4627403 0.3616994 MAXM.4 0.7845877 0.8280014 0.8891065 1.0000000 0.8905531 0.8319364 0.8016013 0.7330967 0.6676087 0.6140884 0.5352284 0.4542338 MAXM.5 0.7219937 0.7932665 0.8328116 0.8905531 1.0000000 0.8944108 0.8418577 0.8053788 0.7447977 0.6708347 0.6054653 0.5355502 MAXM.6 0.6613631 0.7261528 0.7990354 0.8319364 0.8944108 1.0000000 0.8956401 0.8378190 0.8095418 0.7425401 0.6591127 0.6028441 MAXM.7 0.6088920 0.6602437 0.7329438 0.8016013 0.8418577 0.8956401 1.0000000 0.8889466 0.8398561 0.8069203 0.7236006 0.6533578 MAXM.8 0.5441925 0.6102810 0.6642783 0.7330967 0.8053788 0.8378190 0.8889466 1.0000000 0.8900533 0.8366260 0.7999288 0.7184289 MAXM.9 0.4661010 0.5434943 0.6152469 0.6676087 0.7447977 0.8095418 0.8398561 0.8900533 1.0000000 0.8902568 0.8292661 0.7985820 MAXM.10 0.3681705 0.4660501 0.5489423 0.6140884 0.6708347 0.7425401 0.8069203 0.8366260 0.8902568 1.0000000 0.8824213 0.8265274 MAXM.11 0.2635478 0.3594969 0.4627403 0.5352284 0.6054653 0.6591127 0.7236006 0.7999288 0.8292661 0.8824213 1.0000000 0.8764060 MAXM.12 0.1855049 0.2606314 0.3616994 0.4542338 0.5355502 0.6028441 0.6533578 0.7184289 0.7985820 0.8265274 0.8764060 1.0000000
- Gráfico para Temp. Min x Nro Ovos
- Matrix de Correlações para Temperatura Mínima:
cor(dados[grep("MINM", names(dados), value = TRUE)])
MINM.1 MINM.2 MINM.3 MINM.4 MINM.5 MINM.6 MINM.7 MINM.8 MINM.9 MINM.10 MINM.11 MINM.12 MINM.1 1.0000000 0.5639588 0.5935944 0.4695411 0.4268584 0.3489817 0.4377892 0.3114651 0.3413958 0.2429912 0.2596566 0.1516181 MINM.2 0.5639588 1.0000000 0.5716516 0.5956094 0.4809486 0.4282781 0.3581243 0.4359187 0.3149229 0.3388118 0.2518581 0.2510395 MINM.3 0.5935944 0.5716516 1.0000000 0.5654837 0.5830780 0.4787018 0.4267707 0.3459380 0.4420258 0.3042275 0.3215935 0.2361750 MINM.4 0.4695411 0.5956094 0.5654837 1.0000000 0.5665017 0.5951586 0.4772186 0.4186574 0.3520369 0.4453062 0.3120105 0.3237843 MINM.5 0.4268584 0.4809486 0.5830780 0.5665017 1.0000000 0.5682591 0.5964380 0.4782897 0.4197755 0.3504371 0.4462733 0.3087303 MINM.6 0.3489817 0.4282781 0.4787018 0.5951586 0.5682591 1.0000000 0.5630490 0.5926869 0.4832182 0.4245169 0.3456020 0.4373899 MINM.7 0.4377892 0.3581243 0.4267707 0.4772186 0.5964380 0.5630490 1.0000000 0.5582295 0.5944933 0.4809717 0.4288738 0.3371805 MINM.8 0.3114651 0.4359187 0.3459380 0.4186574 0.4782897 0.5926869 0.5582295 1.0000000 0.5604810 0.5943529 0.4713062 0.4097950 MINM.9 0.3413958 0.3149229 0.4420258 0.3520369 0.4197755 0.4832182 0.5944933 0.5604810 1.0000000 0.5603466 0.5704061 0.4600298 MINM.10 0.2429912 0.3388118 0.3042275 0.4453062 0.3504371 0.4245169 0.4809717 0.5943529 0.5603466 1.0000000 0.5500534 0.5539326 MINM.11 0.2596566 0.2518581 0.3215935 0.3120105 0.4462733 0.3456020 0.4288738 0.4713062 0.5704061 0.5500534 1.0000000 0.5521400 MINM.12 0.1516181 0.2510395 0.2361750 0.3237843 0.3087303 0.4373899 0.3371805 0.4097950 0.4600298 0.5539326 0.5521400 1.0000000
- Gráfico para Temp. Min x Nro Ovos
Análises Realisadas
- ++ Binomial Negativa Inflacionada de Zeros |
Não siginificativa++