In jtrecenti/adocao:

Análise CNCA

Pacotes

require(ggplot2)
require(plyr)
require(reshape2)
require(stringr)
require(scales)

Leitura da base

cnca <- read.csv('guia_crianca.csv',sep='@',as.is=T)
cnca$data_nascimento_date <- as.POSIXlt(cnca$data_nascimento, format='%Y-%m-%d')
cnca$ano_nascimento <- as.POSIXlt(cnca$data_nascimento, format='%Y-%m-%d')$year+1900
cnca$data_cadastro_date <- as.POSIXlt(cnca$data_cadastro)
cnca$data_acolhimento_date <- as.POSIXlt(cnca$data_acolhimento, format='%Y-%m-%d')
cnca$idade_cnca <- as.numeric(with(cnca, data_acolhimento_date - data_nascimento_date))/60/60/24/365
cnca <- cnca[!is.na(cnca$data_cadastro_date),]
cnca <- cnca[is.na(cnca$ano_nascimento) | cnca$ano_nascimento<=2013,]
cnca <- cnca[is.na(cnca$idade_cnca) | cnca$idade_cnca>=0,]
for(nome in names(cnca)[-c(8,9,16)]){
  cnca[[nome]] <- gsub('&nbsp;','(vazio)',cnca[[nome]],fixed=T)
  cnca[[nome]] <- gsub('(NULL)','(vazio)',cnca[[nome]],fixed=T)
}
save(cnca, file="cnca.RData")

cnca2 <- cnca[sample(row.names(cnca),size=1000,replace=F),]

ggplot(cnca2, aes(x=as.numeric(idade_cnca))) +
  geom_histogram(aes(y=..density..), colour='black', fill='royalblue', alpha=.50) +
  theme_bw()

dim(cnca)

Graficos

ggbarplot(cnca, "SEXO")
ggbarplot(cnca, "raca_cor")
ggbarplot(cnca[ !cnca$raca_cor%in%"(vazio)",], "raca_cor")
ggbarplot(cnca, "situacao_adocao")

cnca$apto <- ifelse(cnca$situacao_adocao%in%"Não apto","Não","Sim")
ggplot(cnca[as.numeric(cnca$idade_cnca)<18,], aes(x=as.numeric(idade_cnca), fill=apto)) +
  geom_density(alpha=.4) + 
  labs(x="Idade (dias)", y="Densidade", fill="Apto à adoção?") +
  theme_bw()

ggbarplot(cnca, "UF")
ggbarplot(cnca, "ameaca_morte")
ggbarplot(cnca, "irmaos")
ggbarplot(cnca, "freq_escola")

ggbarplot(cnca, "necessidade_especial")
ggbarplot(cnca, "tratamento_especial")

ggbarplot(cnca, "SEXO", "raca_cor")

ggplot(cnca, aes(x=as.numeric(idade_cnca), fill=apto)) +
  geom_density(alpha=.4) + 
  labs(x="Idade (dias)", y="Densidade", fill="Apto à adoção?") +
  facet_wrap(~raca_cor) +
  theme_bw()

contagem_sexo_raca_cor <- data.frame(table(cnca$SEXO,cnca$raca_cor))
names(contagem_sexo_raca_cor) <- c("SEXO", "raca_cor", "Freq")
contagem_sexo_raca_cor$x <- 5000
contagem_sexo_raca_cor$y <- c(3e-04,2.5e-04)
contagem_sexo_raca_cor$label <- paste(contagem_sexo_raca_cor$SEXO, "=",contagem_sexo_raca_cor$Freq)
ggplot(cnca, aes(x=as.numeric(idade_cnca), fill=SEXO)) +
  geom_density(alpha=.4) + 
  labs(x="Idade (dias)", y="Densidade", fill="Sexo") +
  geom_text(data=contagem_sexo_raca_cor, aes(x=x, y=y, label=label)) +
  facet_wrap(~raca_cor) +
  theme_bw()

Dispersao data cadastro vs data acolhimento

cnca$data_acolhimento_date <- as.POSIXlt(cnca$data_acolhimento, format='%Y-%m-%d')
ggplot(cnca, aes(y=as.Date(data_acolhimento_date), x=as.Date(data_cadastro_date), colour=SEXO)) + 
  geom_point(alpha=.2) +
  scale_y_date(limits=as.Date(c("2000-04-01","2013-12-31"), format='%Y-%m-%d'), breaks=date_breaks(width = "6 month"),labels=date_format('%B %Y')) +
  scale_x_date(limits=as.Date(c("2009-10-01","2013-12-31"), format='%Y-%m-%d'), breaks=date_breaks(width = "6 month"),labels=date_format('%B %Y')) + 
  geom_abline(intercept=0, slope=1, colour="red", linetype="dashed") +
  labs(x="Data de cadastro", y="Data de Acolhimento") +
  theme_bw() + 
  theme(axis.text.x=element_text(size=12,angle=45,hjust=1),
        axis.text.y=element_text(size=12),
        axis.title.y=element_text(size=16),
        axis.title.x=element_text(size=16),
        legend.title=element_text(size=14),
        legend.text=element_text(size=12))

tab_reincid_sexo <- prop.table(table(as.Date(cnca$data_acolhimento_date) > as.Date(cnca$data_cadastro_date),cnca$SEXO))

jtrecenti/adocao documentation built on May 20, 2019, 3:15 a.m.