Diferenças

Aqui você vê as diferenças entre duas revisões dessa página.

--- projetos:saudavel:tcc [2008/04/22 19:55] – henriqued
+++ projetos:saudavel:tcc [2008/06/06 16:24] (atual) – henriqued
@@ Linha 1: / Linha 1: @@
 ====== TCC CE 229 ======
+++++ Códigos |<code R>
+## 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()
+</code>
+++++
+==== Verificando a relação entre as covariáves ====
 Carregando os dados:
@@ Linha 6: / Linha 327: @@
 </code>
-  * Matrix de Correlações para Precipitacao:
+  * ++ Matrix de Correlações para Precipitacao:
 <code R>
 cor(dados[grep("PRECIPM", names(dados), value = TRUE)])
@@ Linha 28: / Linha 349: @@
   * Gráfico de Dispersão para Precipitação x Ovos
   {{ http://www.leg.ufpr.br/~henrique/dengue/corPrecip.jpg }}
+++
   * Matrix de Correlações para Umidade:
 <code R>
@@ Linha 98: / Linha 419: @@
   * Gráfico para Temp. Min x Nro Ovos
   {{ http://www.leg.ufpr.br/~henrique/dengue/corMin.jpg }}
+====== Análises Realisadas =======
+  *  ++ Binomial Negativa Inflacionada de Zeros |
+      Não siginificativa++

Diferenças

Navegação

Busca

Ferramentas

QR Code