Você está aqui: start » projetos » saudavel » tcc

Diferenças

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

Link para esta página de comparações

Ambos lados da revisão anteriorRevisão anterior
Próxima revisão		Revisão anterior
projetos:saudavel:tcc [2008/04/25 17:37] – henriquedprojetos:saudavel:tcc [2008/06/06 16:24] (atual) – henriqued
Linha 1: Linha 1:
 ====== TCC CE 229 ====== ====== TCC CE 229 ======
  
-  * [[:projetos:saudavel:tcc:script| Script de Leitura e Manipulação dos Dados]]+++++ 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: Carregando os dados:
Linha 8: Linha 327:
 </code> </code>
  
-  * Matrix de Correlações para Precipitacao:+  * ++ Matrix de Correlações para Precipitacao:
 <code R> <code R>
 cor(dados[grep("PRECIPM", names(dados), value = TRUE)]) cor(dados[grep("PRECIPM", names(dados), value = TRUE)])
Linha 30: Linha 349:
   * Gráfico de Dispersão para Precipitação x Ovos   * Gráfico de Dispersão para Precipitação x Ovos
   {{ http://www.leg.ufpr.br/~henrique/dengue/corPrecip.jpg }}   {{ http://www.leg.ufpr.br/~henrique/dengue/corPrecip.jpg }}
 +++
   * Matrix de Correlações para Umidade:   * Matrix de Correlações para Umidade:
 <code R> <code R>
Linha 102: Linha 421:
  
  
-  * [[:projetos:saudavel:tcc:script| Script de Leitura e Manipulação dos Dados]]+====== Análises Realisadas ======= 
 + 
 +  *  ++ Binomial Negativa Inflacionada de Zeros | 
 +      Não siginificativa++

QR Code
QR Code projetos:saudavel:tcc (generated for current page)