Descritiva - CNA - Crianças Disponíveis

Banco de dados passado pelo CNJ no dia 05/09/2013.

require(ggplot2)
require(stringr)
require(plyr)
require(reshape2)
require(lubridate)
theme.st <- theme_bw() +
  theme(axis.title.x=element_text(size=16),
        axis.title.y=element_text(size=16),
        axis.text.x=element_text(size=16, hjust=0.5),
        axis.text.y=element_text(size=16),
        legend.title=element_text(size=16),
        legend.text=element_text(size=16),
        strip.text.x = element_text(angle=0, size=16),
        strip.text.y = element_text(angle=-90, size=16))

theme.boxplot.uni <- theme(axis.title.y=element_blank(),
                           axis.title.x=element_text(size=16),
                           axis.text.y=element_blank(),
                           axis.text.x=element_text(size=16),
                           axis.ticks.y=element_blank(),
                           legend.title=element_text(size=16),
                           legend.text=element_text(size=16))

theme.boxplot.bi <- theme(axis.title.x=element_blank(),
                          axis.title.y=element_text(size=16),
                          axis.text.x=element_text(size=12, angle=90, hjust=1, vjust=0.5),
                          axis.text.y=element_text(size=16),
                          axis.ticks.x=element_blank(),
                          legend.title=element_text(size=16),
                          legend.text=element_text(size=16))
# Carregando e limpando CSV
cna_disp <- read.csv2('/home/CNJ/CNA/bd/cna_crianca_disp.csv', as.is=T)

#names(cna_disp)

cna_disp$data_disponibilizacao_num <- as.POSIXlt(cna_disp$DT.Disponibilização.Criança, format='%d/%m/%Y')
cna_disp$ano_disponibilizacao_num <- cna_disp$data_disponibilizacao_num$year + 1900
cna_disp$data_nascimento_num <- as.POSIXlt(cna_disp$data_nascimento, format='%d/%m/%Y')

#View(cna_disp[!is.na(cna_disp$ano_disponibilizacao_num) & cna_disp$ano_disponibilizacao_num < 1990,])

cna_disp$data_ultima_alteracao <- as.POSIXlt(cna_disp$Ult.Alteração, format='%d/%m/%Y %H:%M') 

cna_disp_limpo <- cna_disp[!is.na(cna_disp$ano_disponibilizacao_num) & 
                             cna_disp$ano_disponibilizacao_num >= 2000 & 
                             cna_disp$ano_disponibilizacao_num < 2014,]

# # verifica se ano_disponibilizacao_num e Ano.Disp.Adoção são a mesma coisa
# summary(with(cna_disp_limpo, ano_disponibilizacao_num - Ano.Disp.Adoção))
# table(is.na(cna_disp_limpo$ano_disponibilizacao_num),is.na(cna_disp_limpo$Ano.Disp.Adoção))

Retirada de r sum(is.na(cna_disp$data_disponibilizacao_num)) obs do BD por não ter informação da data de disponibilização.

Análise descritiva das crianças disponíveis

Com que idade as crianças ficaram disponíveis?

cna_disp_limpo$idade_disponibilizacao <- as.numeric(with(cna_disp_limpo, data_disponibilizacao_num - data_nascimento_num)/60/60/24/365)

cna_disp_limpo <- cna_disp_limpo[cna_disp_limpo$idade_disponibilizacao >=0 & cna_disp_limpo$idade_disponibilizacao <=18,]

Graficos exploratorios

ggplot(cna_disp_limpo, aes(x=idade_disponibilizacao)) +
         geom_histogram(aes(y=..density..), color='black', fill='white')+
         scale_x_continuous(breaks=0:18) +
         theme_bw()

ggplot(cna_disp_limpo, aes(x=idade_disponibilizacao)) +
         geom_histogram(aes(y=..density.., fill=situacao_crianca))+
         scale_x_continuous(breaks=0:18) +
         theme_bw()

totais <- as.data.frame(table(cna_disp_limpo$situacao_crianca))
totais$n <- paste('n =', totais$Freq)
totais$x <- 18
totais$y <- .5

ggplot(cna_disp_limpo, aes(x=idade_disponibilizacao, group=situacao_crianca)) +
  geom_histogram(aes(y=..density..), color='black', fill='white') +
  geom_text(data=totais, aes_string(x='x', y='y', label='n', group='Var1'), colour="black")+
  facet_wrap(~situacao_crianca) +
  labs(x='Idade de Disponibilização', y='Densidade') + 
  theme_bw()

#quantile(cna_disp_limpo$idade_disponibilizacao[cna_disp_limpo$situacao_crianca %in% "Disponivel"],probs=c(0,0.15,1))

ggplot(cna_disp_limpo, aes(x=situacao_crianca, y=idade_disponibilizacao)) + 
  geom_boxplot() +
  theme_bw()

for(i in names(cna_disp_limpo)) {
  print(i)
  print(table(cna_disp_limpo[[i]]))
}

Qual é o destino de crianças para cada faixa etária?

breaks <- c(0,1,2,3,4,5,6,7,8,9,10,11,12,13,17,Inf)
cna_disp_limpo$faixa_etaria_disponibilizacao <- cut(cna_disp_limpo$idade_disponibilizacao, breaks=breaks, include.lowest=T)
levs <- levels(cna_disp_limpo$faixa_etaria_disponibilizacao)
levels(cna_disp_limpo$faixa_etaria_disponibilizacao) <- c(levs[-length(levs)], '18 anos')

cna_disp_limpo$situacao_crianca2 <- factor(cna_disp_limpo$situacao_crianca)
levels(cna_disp_limpo$situacao_crianca2) <- c("Adotada", "Adotada", "Adotada", "Adoção em andamento", 'Maioridade', 'Disponível', 'Adoção em andamento', 'Faleceu', 'Consulta', 'Censura', 'Consulta','Censura')
cna_disp_limpo$situacao_crianca3 <- factor(cna_disp_limpo$situacao_crianca)
levels(cna_disp_limpo$situacao_crianca3) <- c("Adotada", "Adotada", "Adotada", "Outros", 'Maioridade', 'Disponível', 'Outros', 'Outros', 'Outros', 'Outros', 'Outros','Outros')

tab <- with(cna_disp_limpo, table(situacao_crianca3,faixa_etaria_disponibilizacao))
tab_df <- merge(tab, prop.table(tab,2), by=c('situacao_crianca3', 'faixa_etaria_disponibilizacao'))
tab_df <- merge(tab_df, data.frame(margin.table(tab,2)), by='faixa_etaria_disponibilizacao')
tab_df$situacao_crianca3 <- as.character(tab_df$situacao_crianca3)

ggplot(tab_df, aes(x=faixa_etaria_disponibilizacao, y=Freq.y*100, group=situacao_crianca3, colour=situacao_crianca3)) + 
  geom_point() +
  geom_line() +
  geom_text(aes(x=faixa_etaria_disponibilizacao, y=80, label=Freq), color="black", alpha=.1, size=5) +
  labs(x='Idade de disponibilização (anos)', y='%', colour='Situação atual da criança') +
  theme.st

Analise dos 965 que atingiram maioridade

cna_disp_limpo_maior <- cna_disp_limpo[cna_disp_limpo$situacao_crianca %in% "Atingiu Maioridade",]
cna_disp_limpo_nmaior <- cna_disp_limpo[!cna_disp_limpo$situacao_crianca %in% "Atingiu Maioridade",]

tab_df <- data.frame(prop.table(table(cna_disp_limpo_maior$UF.abrigo)))
tab_df2 <- data.frame(prop.table(table(cna_disp_limpo_nmaior$UF.abrigo)))
tab_df_tot <- merge(tab_df2,tab_df,by='Var1', all.x=T)
names(tab_df_tot) <- c('UF', 'prop_brasil', 'prop_maior')
pchisq(sum((tab_df_tot$prop_maior-tab_df_tot$prop_brasil)^2/tab_df_tot$prop_brasil, na.rm=T),df=26,lower.tail=F)

tab_df <- data.frame(prop.table(table(cna_disp_limpo_maior$faixa_etaria_disponibilizacao)))
tab_df2 <- data.frame(prop.table(table(cna_disp_limpo_nmaior$faixa_etaria_disponibilizacao)))
tab_df_tot <- merge(tab_df2,tab_df,by='Var1', all.x=T)
names(tab_df_tot) <- c('UF', 'prop_brasil', 'prop_maior')
pchisq(sum((tab_df_tot$prop_maior-tab_df_tot$prop_brasil)^2/tab_df_tot$prop_brasil, na.rm=T),df=nrow(tab_df_tot)-1,lower.tail=F)


teste <- function(var) {
  tab_df <- data.frame(table(cna_disp_limpo_maior[[var]]))
  tab_df2 <- data.frame(prop.table(table(cna_disp_limpo_nmaior[[var]]))*(sum(tab_df$Freq)))
  tab_df_tot <- merge(tab_df2,tab_df,by='Var1', all.x=T)
  names(tab_df_tot) <- c(var, 'prop_brasil', 'prop_maior')
  chisquare <- sum((tab_df_tot$prop_maior-tab_df_tot$prop_brasil)^2/tab_df_tot$prop_brasil, na.rm=T)
  vp <- pchisq(chisquare,df=nrow(tab_df_tot)-1,lower.tail=F)
  return(list(tab_df_tot, vp))  
}

(df_testes <- lapply(names(cna_disp_limpo)[c(7:13,15:33,38)],teste))

df_testes[sapply(df_testes, function(x) x[[2]] < 1e-10)]

addmargins(round(prop.table(table(cna_disp_limpo$faixa_etaria_disponibilizacao, cna_disp_limpo$entrega_voluntaria),2)*100,2),1)
addmargins(round(prop.table(table(cna_disp_limpo$faixa_etaria_disponibilizacao, cna_disp_limpo$obito_dos_pais),2)*100,2),1)

Idade de disponibilizacao vs origem

compara <- function(variavel, label=variavel) {
  totais <- as.data.frame(table(cna_disp_limpo[[variavel]]))
  totais$n <- paste('n =', totais$Freq)
  totais$x <- 16
  totais$y <- .15
  totais[[variavel]] <- as.character(totais$Var1)

  cna_disp_limpo[[variavel]] <- as.character(cna_disp_limpo[[variavel]])
  ggplot(cna_disp_limpo, aes_string(x='idade_disponibilizacao', group=variavel)) +
    geom_histogram(aes(y=..density..), color='black', fill='white', binwidth=1) +
    facet_wrap(as.formula(paste('~',variavel))) +
    geom_text(data=totais, aes_string(x='x', y='y', label='n', group=variavel), colour="black")+
    scale_x_continuous(breaks=0:18) +
    labs(x='Idade de Disponibilização', y='Densidade', title=label) + 
    theme_bw()
}


totais <- as.data.frame(table(cna_disp_limpo$situacao_crianca))
totais$n <- paste('n =', totais$Freq)
totais$x <- 16
totais$y <- .5
totais$situacao_crianca <- totais$Var1

ggplot(cna_disp_limpo, aes(x=idade_disponibilizacao, group=situacao_crianca)) +
  geom_histogram(aes(y=..density..), color='black', fill='royalblue', binwidth=1, alpha=.8) +
  facet_wrap(~situacao_crianca) +
  geom_text(data=totais, aes_string(x='x', y='y', label='n', group='situacao_crianca'), colour="black")+
  scale_x_continuous(breaks=seq(0,18,by=2)) +
  labs(x='Idade de Disponibilização', y='Densidade') + 
  theme_bw() +
  theme(strip.text.x=element_text(size=12),
        axis.text=element_text(size=11),
        axis.title=element_text(size=14))

total <- data.frame(nrow(cna_disp_limpo), n=paste('n =',nrow(cna_disp_limpo)), x=15, y=0.14)
ggplot(cna_disp_limpo, aes(x=idade_disponibilizacao)) +
  geom_histogram(aes(y=..density..), color='black', fill='lightblue', binwidth=.5, alpha=.1) +
  geom_text(data=total, aes_string(x='x', y='y', label='n'), colour="black")+
  scale_x_continuous(breaks=seq(0,18,by=1)) +
  labs(x='Idade de Disponibilização', y='Densidade') + 
  theme_bw() +
  theme(strip.text.x=element_text(size=12),
        axis.text=element_text(size=11),
        axis.title=element_text(size=14))


p1 <- compara('obito_dos_pais')
p2 <- compara('descumprimento_injustificado_reiterado_dos_deveres_do_poder_familiar')
p3 <- compara('ambiente_contrario_a_moral_e_bons_costumes')
p4 <- compara('pais_desconhecidos')
p5 <- compara('entrega_voluntaria')
p6 <- compara('abandono')

source('multiplot.R')
multiplot(p1,p2,p3,p4,p5,p6, cols=2)
compara2 <- function(variavel, label=variavel) {
  totais <- as.data.frame(table(cna_disp_limpo[[variavel]]))
  totais$n <- paste('n =', totais$Freq)
  totais$x <- 16
  totais$y <- 18+1
  totais[[variavel]] <- as.character(totais$Var1)

  cna_disp_limpo[[variavel]] <- as.character(cna_disp_limpo[[variavel]])
  ggplot(cna_disp_limpo, aes_string(y='idade_disponibilizacao', x=variavel)) +
    geom_boxplot() +
    geom_text(data=totais, aes_string(x=variavel, y='y', label='n'), colour="black")+
    labs(x=label, y='Idade de Disponibilização') + 
    theme_bw()
}


p1 <- compara2('obito_dos_pais')
p2 <- compara2('descumprimento_injustificado_reiterado_dos_deveres_do_poder_familiar')
p3 <- compara2('ambiente_contrario_a_moral_e_bons_costumes')
p4 <- compara2('pais_desconhecidos')
p5 <- compara2('entrega_voluntaria')
p6 <- compara2('abandono')

source('multiplot.R')
multiplot(p1,p2,p3,p4,p5,p6, cols=2)
compara3 <- function(variavel, label=variavel) {
  totais <- as.data.frame(table(cna_disp_limpo[[variavel]]))
  totais$n <- paste(c('',''),'n = ', totais$Freq, sep='')
  totais$x <- 16
  totais$y <- .15
  totais[[variavel]] <- as.character(totais$Var1)

  cna_disp_limpo[[variavel]] <- as.character(cna_disp_limpo[[variavel]])
  ggplot(cna_disp_limpo, aes_string(x='idade_disponibilizacao', fill=variavel)) +
    geom_histogram(aes(y=..density..), binwidth=1, position='identity',alpha=.5) +
    scale_x_continuous(breaks=0:18) +
    labs(x='Idade de Disponibilização', y='Densidade', title=label, fill='') + 
    scale_fill_discrete(labels=paste(c('não (','sim ('),totais$n, ')', sep='')) +
    theme_bw() +
    theme(legend.position=c(.87,.77),
          legend.background = element_rect(fill="transparent", size=.5, linetype="dotted"))
}

labels <- c('\nÓbito dos pais', 'Descumprimento injustificado \ndos deveres do poder familiar', 'Ambiente contrário a\n moral e os bons costumes', '\nPais desconhecidos', '\nEntrega voluntária','\nAbandono','\nCastigo Imoderado')
p1 <- compara3('obito_dos_pais', labels[1])
p2 <- compara3('descumprimento_injustificado_reiterado_dos_deveres_do_poder_familiar', labels[2])
p3 <- compara3('ambiente_contrario_a_moral_e_bons_costumes', labels[3])
p4 <- compara3('pais_desconhecidos', labels[4])
p5 <- compara3('entrega_voluntaria', labels[5])
p6 <- compara3('abandono', labels[6])
p7 <- compara3('castigo_imoderado', labels[7])

source('/home/CNJ/CNA/multiplot.R')
multiplot(p2,p3,p6,p1,p4,p5,p7, cols=2)


sum(floor(cna_disp_limpo$idade_disponibilizacao) %in% 7:10)/sum(floor(cna_disp_limpo$idade_disponibilizacao) %in% 0:18)
sum(floor(cna_disp_limpo$idade_disponibilizacao) %in% 0:2)/sum(floor(cna_disp_limpo$idade_disponibilizacao) %in% 0:18)
sum(floor(cna_disp_limpo$idade_disponibilizacao) %in% 3:6)/sum(floor(cna_disp_limpo$idade_disponibilizacao) %in% 0:18)
require(plyr)
tapply(cna_disp_limpo$idade_disponibilizacao, cna_disp_limpo$obito_dos_pais, median)
tapply(cna_disp_limpo$idade_disponibilizacao, cna_disp_limpo$descumprimento_injustificado_reiterado_dos_deveres_do_poder_familiar, median)
tapply(cna_disp_limpo$idade_disponibilizacao, cna_disp_limpo$ambiente_contrario_a_moral_e_bons_costumes, median)
tapply(cna_disp_limpo$idade_disponibilizacao, cna_disp_limpo$pais_desconhecidos, median)
tapply(cna_disp_limpo$idade_disponibilizacao, cna_disp_limpo$entrega_voluntaria, median)
tapply(cna_disp_limpo$idade_disponibilizacao, cna_disp_limpo$abandono, median)


teste <- function(x,y) {
  t.test(x[y==0], x[y==1])
}
with(cna_disp_limpo, teste(idade_disponibilizacao, obito_dos_pais))
with(cna_disp_limpo, teste(idade_disponibilizacao, descumprimento_injustificado_reiterado_dos_deveres_do_poder_familiar))
with(cna_disp_limpo, teste(idade_disponibilizacao, ambiente_contrario_a_moral_e_bons_costumes))
with(cna_disp_limpo, teste(idade_disponibilizacao, entrega_voluntaria))
with(cna_disp_limpo, teste(idade_disponibilizacao, abandono))

Combinações

cna_disp_limpo$comb_motivos <- with(cna_disp_limpo, paste(obito_dos_pais,
                                                          descumprimento_injustificado_reiterado_dos_deveres_do_poder_familiar,
                                                          ambiente_contrario_a_moral_e_bons_costumes,
                                                          pais_desconhecidos,
                                                          entrega_voluntaria,
                                                          abandono, sep=''))

round(table(cna_disp_limpo$comb_motivos)/sum(table(cna_disp_limpo$comb_motivos))*100,2)
# Daqui eu concluo que as variáveis aparecem quase sempre sozinhas (70% das vezes)

Qual é o tempo de adoção após entrar no cadastro? Ainda não temos a informação da data da última atualização.


Entrega voluntária versus situacao da crianca

table(cna_disp_limpo$situacao_crianca, cna_disp_limpo$entrega_voluntaria)

var.categ.principal <- "entrega_voluntaria"
título.var.categ.principal <- "entrega_voluntaria"
var.categ.secundaria <- "situacao_crianca"
título.var.categ.secundaria <- "situacao_crianca"

tab <- table(cna_disp_limpo[,var.categ.secundaria], cna_disp_limpo[,var.categ.principal])
chisq.teste <- chisq.test(tab)$p.value
intercala(addmargins(tab,1),porcentagem_na_coluna(tab))

df <- as.data.frame(tab)
df$Tot <- rep(tapply(df$Freq, df$Var2, sum),each=length(levels(df$Var1)))
df$Prop <- with(df, Freq/Tot)
df$Lab <- with(df, paste(round(100*Prop,0),"%",sep=""))
df <- df[!is.nan(df$Prop),]

ggplot(df, aes(x = Var1, fill = Var1)) +
  geom_bar(position = "dodge", aes(weights = Prop)) +
  ylim(c(0,1)) +
  geom_text(aes(y=Prop+.03, label=Lab), size = 5) +
  labs(fill=título.var.categ.secundaria, title=título.var.categ.principal, x="", y = "Proporção", title="") +
  facet_grid(. ~ Var2 , scales = "free_x") +
  geom_text(aes(y=1, x=rep(ifelse(df[df$Var1==levels(df$Var1)[2],"Prop"]>0.75,1,2),each=length(levels(Var1))), label=paste("n =",Tot))) +
  theme_bw() +
  theme(axis.title.x=element_text(size=16),
        axis.title.y=element_text(size=16),
        axis.text.x=element_blank(),
        axis.text.y=element_text(size=12),
        axis.ticks=element_blank(),
        legend.title=element_text(size=16),
        legend.text=element_text(size=14),
        legend.key.size = unit(1.5, "cm"),
        strip.text.x = element_text(size=15))

Pedidos do Adilson

# Gostaria de propor uma conta; 
# 
# Vejam se agrega e se ajuda:
# Escolham duas categorias, digamos A e B.
# A categoria A poderia ser alguma faixa etária qualquer e a categoria B poderia ser não adotado. Divida a frequência relativa de A e B pelo produto das frequências relativas de A e de B. (Vamos chamar isto inicialmente de Lift).
# 
# Se o Lift for 1 então independência.
# Se o Lift for maior que 1 então A induz B.
# Se o Lift for menor que 1 então A inibe B.
# 
# Depois basta construir uma Matriz de As contra Bs ( a diagonal eh 1, claro) e partir para uma analise. Gostaria de ver...

# Ops, de fato a diagonal eh 1 na escala inversa da f(A). A diagonal dara o peso relativo da linha i e coluna j sobre o cadastro. Bom, se quiserem, conversamos + sobre isto depois. Abs


ggplot(cna_disp_limpo, aes(x=ano_disponibilizacao_num)) + 
  geom_histogram(aes(y=..density..), color='black', fill='white', binwidth=1) +
  scale_x_continuous(breaks=1999:2013) +
  theme_bw()

Tentativa do Julio: regressão logística para calcular probabilidade de adoção (estudo prospectivo!!!) Problema: as crianças disponíveis ainda podem apresentar o evento "adoção"

unique(cna_disp_limpo$situacao_crianca2)

cna_disp_limpo_logistica <- cna_disp_limpo[cna_disp_limpo$situacao_crianca2 %in% c('Maioridade','Adotada'), ]
cna_disp_limpo_logistica$situacao_crianca2 <- as.character(cna_disp_limpo_logistica$situacao_crianca2)

cna_disp_limpo_logistica$Y <- ifelse(cna_disp_limpo_logistica$situacao_crianca2 %in% 'Adotada', 1,0)
fit.model <- glm(Y ~ sexo + regiao_estado_nascimento + tem_irmao + raca_cor + doenca_hiv + obito_dos_pais + entrega_voluntaria + idade_disponibilizacao, data=cna_disp_limpo_logistica, family=binomial)

summary(fit.model)

source('http://www.ime.usp.br/~giapaula/envel_bino')

Análise de sobrevivência para o tempo até a adoção

Kaplan meier para tempo até a adocao explicado por idade de disponibilidade

library(survival)
source("ggkm.R")

# indicador de idade de disponibilização maior que 5 anos
breaks <- c(0,5,Inf)
cna_disp_limpo$faixa_etaria_disponibilizacao <- cut(cna_disp_limpo$idade_disponibilizacao, breaks=breaks, include.lowest=T)

cna_disp_limpo$idade_disponibilizacao_5anosflag <- ifelse(cna_disp_limpo$idade_disponibilizacao > 5, 1, 0)

# tempo até evento, em dias
cna_disp_limpo$tempo_ate_evento <-  with(cna_disp_limpo, as.numeric(data_ultima_alteracao - data_disponibilizacao_num)/24)

# flag para adocao
cna_disp_limpo$adotada <- ifelse(cna_disp_limpo$situacao_crianca2 %in% 'Adotada', 1,0)

# kaplan meier para tempo até a adocao explicado por idade de disponibilidade

ekm <- survfit(Surv(tempo_ate_evento, adotada) ~ faixa_etaria_disponibilizacao, data=cna_disp_limpo[cna_disp_limpo$situacao_crianca2%in%c("Adotada","Maioridade","Disponível"),])
a <-ggkm(sfit=ekm, returns=TRUE)

a + scale_x_continuous(breaks=seq(0,4800,200)) + labs(x="dias", y="Probabilidade de 'sobrevivência'")

Agora segregado por sexo.

A ideia é ver se meninas sofrem com a idade tanto quanto meninos.

# Meninas
ekm <- survfit(Surv(tempo_ate_evento, adotada) ~ idade_disponibilizacao_5anosflag, data=cna_disp_limpo[cna_disp_limpo$sexo%in%"F",])
ggkm_f <- ggkm(sfit=ekm, returns=TRUE, main="Feminino")

# Meninos
ekm <- survfit(Surv(tempo_ate_evento, adotada) ~ idade_disponibilizacao_5anosflag, data=cna_disp_limpo[cna_disp_limpo$sexo%in%"M",])
ggkm_m <- ggkm(sfit=ekm, returns=TRUE, main="Masculino")

multiplot(ggkm_f, ggkm_m, cols=2)

Invertendo a perspectiva. KMs dos sexos para cada faixa etária. Parece que sexo não faz diferença.

# < 5 anos
ekm <- survfit(Surv(tempo_ate_evento, adotada) ~ sexo, data=cna_disp_limpo[cna_disp_limpo$idade_disponibilizacao_5anosflag%in%0,])
ggkm_n <- ggkm(sfit=ekm, returns=TRUE, main="< 5 anos")

# > 5 anos
ekm <- survfit(Surv(tempo_ate_evento, adotada) ~ sexo, data=cna_disp_limpo[cna_disp_limpo$idade_disponibilizacao_5anosflag%in%1,])
ggkm_v <- ggkm(sfit=ekm, returns=TRUE, main="> 5 anos")

multiplot(ggkm_n, ggkm_v, cols=2)

Invertendo a perspectiva. KMs dos sexos para cada faixa etária. Parece que sexo não faz diferença.

# < 5 anos
ekm <- survfit(Surv(tempo_ate_evento, adotada) ~ sexo, data=cna_disp_limpo[cna_disp_limpo$idade_disponibilizacao_5anosflag%in%0,])
ggkm_n <- ggkm(sfit=ekm, returns=TRUE, main="< 5 anos")

# > 5 anos
ekm <- survfit(Surv(tempo_ate_evento, adotada) ~ sexo, data=cna_disp_limpo[cna_disp_limpo$idade_disponibilizacao_5anosflag%in%1,])
ggkm_v <- ggkm(sfit=ekm, returns=TRUE, main="> 5 anos")

multiplot(ggkm_n, ggkm_v, cols=2)

Idade pretendentes vs pretendidos

crianca_disponivel <- cna_disp[cna_disp$situacao_crianca %in% "Disponivel",]
pretendente_disponivel <- cna_pre[cna_pre$Situação.Pretendente %in% "Ativo",]

df <- data.frame(crianca = prop.table(table(crianca_disponivel$anos_completos)),
                 pretendente = -prop.table(table(pretendente_disponivel$idade_maxima)))
df2 <- melt(df)

  cna_disp_limpo[[variavel]] <- as.character(cna_disp_limpo[[variavel]])

df2$crianca.Var1.num <- as.numeric(as.character(df2$crianca.Var1))
df2$pretendente.Var1.num <- as.numeric(as.character(df2$pretendente.Var1))
ggplot(df2, aes(x=pretendente.Var1, y=value, fill=variable)) +
  geom_bar(data=df2[df2$variable%in%'crianca.Freq',], aes(x=crianca.Var1.num, y=value), alpha=.5, stat='identity',position='stack') +
  geom_bar(data=df2[df2$variable%in%'pretendente.Freq',], aes(x=pretendente.Var1.num, y=value), alpha=.5, stat='identity') +
  #scale_x_continuous(breaks=0:18) +
  #labs(x='Idade', y='Densidade', fill='') + 
  #scale_fill_discrete(labels=paste(c('não (','sim ('),totais$n, ')', sep='')) +
  theme_bw() +
  ylim(c(-.2,.2)) +
  scale_x_discrete(breaks=0:18,limits=0:18) +
  theme(legend.position=c(.6,.3),
        legend.background = element_rect(fill="transparent", size=.5, linetype="dotted"))

Qtd de entradas por intervalo de tempo

names(cna_disp_limpo)
require(dplyr)

cna_disp_limpo$anomes_disponibilizacao <- paste(year(cna_disp_limpo$data_disponibilizacao_num), 
                                                sprintf('%02d', month(cna_disp_limpo$data_disponibilizacao_num)))
table(cna_disp_limpo$anomes_disponibilizacao[cna_disp_limpo$ano_disponibilizacao_num >= 2008])
hist(table(cna_disp_limpo$anomes_disponibilizacao[cna_disp_limpo$ano_disponibilizacao_num >= 2008]))
ggplot(data.frame(table(cna_disp_limpo$anomes_disponibilizacao[cna_disp_limpo$ano_disponibilizacao_num >= 2008])), 
       aes(x=Var1, y=Freq, group=1)) + geom_point() + geom_line() + theme(axis.text.x=element_text(angle=45, hjust=1))


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