[R-br] Criação de um Fluxograma
Abel Brasil Ramos da Silva
abelbrasil88 em gmail.com
Quarta Setembro 14 17:27:42 BRT 2016
Olá Pedro,
Cara, muitíssimo obrigado por disponibilizar seu cmd vou começar a usa-lo e
replica-lo com meus dados.
Obrigado mais uma vez.
Abs.
Em 14 de setembro de 2016 16:13, Pedro Emmanuel Alvarenga Americano do
Brasil <emmanuel.brasil em gmail.com> escreveu:
> Ei Abel,
>
> Por coincidencia eu acabei de fazer um. Segue abaixo o script que usei. É
> grande, mas eu acho que fica bacana. É baseado num exemplo do pacote
> diagram.
>
> # Meus bancos são sempre uma letra
> # Essa primeira seção é pra criar um objeto com as quantidades que seriam
> excluidas
> # Total de sujeitos incluidos
> total <- nrow(b)
> total
>
> # Idade label(b$v6)
> cond <- which(b$v6 == "No")
> if(length(cond) > 0) {
> b <- b[-cond, ]
> }
> cond.idade <- total - nrow(b)
>
> # Excluindo os HIV positivo
> cond <- which(b$v7 == "No")
> if(length(cond) > 0) {
> b <- b[-cond, ]
> }
> cond.semhiv <- total - cond.idade - nrow(b)
>
> # Assinou o TCLE v8
> cond <- which(b$v8 == "No")
> if(length(cond) > 0){
> b <- b[-cond, ]
> }
> cond.TCLE <- total - cond.idade - cond.semhiv - nrow(b)
>
> # Tosse ou RX sugestiva de TB v9
> cond <- which(b$v9 == "No")
> if(length(cond) > 0) {
> b <- b[-cond, ]
> }
> cond.tosse <- total - cond.TCLE - cond.idade - cond.semhiv - nrow(b)
>
> # CD4 abaixo de 200 v10
> cond <- which(b$v10 == "No")
> if(length(cond) > 0) {
> b <- b[-cond, ]
> }
> cond.CD4 <- total - cond.tosse - cond.TCLE - cond.idade - cond.semhiv -
> nrow(b)
>
> # Gestatnes v11
> cond <- which(b$v11 == "No")
> if(length(cond) > 0) {
> b <- b[-cond, ]
> }
> cond.gestante <- total - cond.CD4 - cond.tosse - cond.TCLE - cond.idade -
> cond.semhiv - nrow(b)
>
> # Amostra para LAM v12
> cond <- which(b$v12 == "No")
> if(length(cond) > 0) {
> b <- b[-cond, ]
> }
> cond.urina <- total - cond.gestante - cond.CD4 - cond.tosse - cond.TCLE -
> cond.idade - cond.semhiv - nrow(b)
>
> # Amostra de escarro v13
> cond <- which(b$v13 == "No")
> if(length(cond) > 0) {
> b <- b[-cond, ]
> }
> cond.escarro <- total - cond.urina - cond.gestante - cond.CD4 - cond.tosse
> - cond.TCLE - cond.idade - cond.semhiv - nrow(b)
>
> # Usou tuberculostaticos no ultimos 30 dias
> cond <- which(b$v13b == "No")
> if(length(cond) > 0){
> b <- b[-cond, ]
> }
> cond.medicamento <- total - cond.escarro - cond.urina - cond.gestante -
> cond.CD4 - cond.tosse - cond.TCLE - cond.idade - cond.semhiv - nrow(b)
>
> # Essa seção é pra criar um objeto que tenha os totais que sobram no banco
> e as quantidade que são retiradas.
>
> tmp1 <- c(total,cond.TCLE,cond.idade,cond.semhiv,cond.tosse,cond.
> CD4,cond.gestante,cond.urina,cond.escarro,cond.medicamento)
> names(tmp1)[1] <- "Total"
> tmp2 <- c(cond.TCLE,cond.idade,cond.semhiv,cond.tosse,cond.CD4,
> cond.gestante,cond.urina,cond.escarro,cond.medicamento)
> names(tmp2) <- c("Didn't consent","Age < 18","HIV negative","No cough and
> normal X-ray","CD4+ > 200","Pregnancy","No urine available","No sputum
> available","Previous use of TB drugs")
> for(i in 2:length(tmp1)){tmp1[i] <- tmp1[i - 1] - tmp2[i - 1]}; rm(i)
> exclusao <- NA
> for(i in seq_along(tmp2)){
> exclusao <- c(exclusao,c(tmp1[i],tmp2[i]))
> };rm(i)
> exclusao <- c(exclusao,c(tmp1[length(tmp1)]))
> exclusao <- exclusao[-which(is.na(exclusao))]
>
> > exclusao
> Total Didn't consent
> <NA> Age < 18 <NA>
> 278 0
> 278 0 278
> HIV negative <NA> No cough and normal
> X-ray <NA> CD4+ > 200
> 25 253
> 1 252 45
> <NA> Pregnancy
> <NA> No urine available <NA>
> 207 0
> 207 1 206
> No sputum available <NA> Previous use of TB
> drugs <NA>
> 5 201
> 1 200
> > dput(exclusao)
> structure(c(278L, 0L, 278L, 0L, 278L, 25L, 253L, 1L, 252L, 45L,
> 207L, 0L, 207L, 1L, 206L, 5L, 201L, 1L, 200L), .Names = c("Total",
> "Didn't consent", NA, "Age < 18", NA, "HIV negative", NA, "No cough and
> normal X-ray",
> NA, "CD4+ > 200", NA, "Pregnancy", NA, "No urine available",
> NA, "No sputum available", NA, "Previous use of TB drugs", NA
> ))
>
> rm(tmp1,tmp2,total,cond,cond.CD4,cond.escarro,cond.
> gestante,cond.idade,cond.medicamento,cond.semhiv,cond.
> TCLE,cond.tosse,cond.urina)
>
> # Aqui um função baseada no diagram.
> # coord é uma matriz com as quantidades de colunas em cada linha onde os
> baloes serão colocados. No padrão ha duas colunas na primeira linha, duas
> na segunda... e uma coluna na ultima.
> # ft é uma matriz com duas colunas que indica onde as setas iniciam e
> terminam. Então se a primeira linha é 1,2 a seta inicia na posição superior
> esquerda e termina na posição superior direita no exemplo. se a linha for
> 1,3 a seta começa no superior esquerdo e termina no balçao imediatamente
> abaixo. Com apenas duas colunas todas as posição pares são a esquerda e a
> impares são a direita. A posição 5 e 7 são os baloes da esquerda da
> terceira e quarta linha respectiva. demorei a entender esses
> posicionamentos do diagram, mas uma vez entendido fica facil.
> # os demais argumentos são configurações passadas para a
> diagram::textellipse e diagram::straightarrow
>
> plot.flowchart <- function(tmp, coord=c(2,2,2,2,2,2,2,2,2,1),
> ft=c(1,2,1,3,3,4,3,5,5,6,5,7,7,8,7,9,9,10,9,11,11,12,11,13,
> 13,14,13,15,15,16,15,17,17,18,17,19),radx=.18,rady=.05,arr.
> pos=0.6,arr.length=0.6,shadow.size=0,cex=.85){
> require(diagram)
>
> # Criando as matrizes com as posi??es dos baloes
> elpos <- coordinates(coord)
> fromto <- matrix(ncol = 2, byrow = TRUE, data = ft)
> arrpos <- matrix(ncol = 2, nrow = nrow(fromto))
>
> # reduzindo as margens
> par(mar=c(1,1,1,1))
>
> # Iniciando o grafico
> require(diagram)
> openplotmat()
>
> # Colocando as setas no grafico
> for (i in 1:nrow(fromto)){
> arrpos[i,]<- straightarrow(to=elpos[fromto[
> i,2],],from=elpos[fromto[i,1],],lwd=1,arr.pos=arr.pos,arr.
> length=arr.length)
> }
>
> # COlocando os baloes no gr?fico
> for(i in seq_along(tmp)){
> if(!is.na(names(tmp[i]))){
> textellipse(elpos[i,],lab=paste(names(tmp[i]),"\n",tmp[
> i]),radx=radx,rady=rady,shadow.size=shadow.size,cex=cex)
> } else {
> textellipse(elpos[i,],lab=tmp[i],radx=radx,rady=rady,shadow.
> size=shadow.size,cex=cex)
> }
> }
> }
> plot.flowchart(exclusao)
>
> Pedro Brasil
>
> Em 14 de setembro de 2016 11:28, Abel Brasil Ramos da Silva via R-br <
> r-br em listas.c3sl.ufpr.br> escreveu:
>
>> Olá a todos,
>>
>> Gostaria de saber como faço para produzir um fluxograma/diagrama de um
>> data.frame, a ideia é produzir algo desse tipo, porém inserindo os totais
>> de cada subamostra e a porcentagem em cada nó.
>>
>> P.S: A forma de saída pode ser qualquer uma.
>>
>> |Econômica
>> /--S --- classe |Master
>> |Executiva
>> M---surv |
>> |Econômica
>> \--N --- classe |Master
>> |Executiva
>> sex--|
>> |Econômica
>> /--S --- classe |Master
>> |Executiva
>> F---surv |
>> |Econômica
>> \--N --- classe |Master
>> |Executiva
>>
>> Exemplo seria um banco similar a esse:
>>
>> set.seed(1)
>> sexo=sample(c(0,1),50,replace=T)
>> sexo=factor(sexo,levels=c(0,1),label=c("Feminino","Masculino"))
>> surv=sample(c(0,1),50,replace=T)
>> surv=factor(surv,levels=c(0,1),label=c("Não","Sim"))
>> classe=sample(c(0,1,2),50,replace=T)
>> classe=factor(classe,levels=c(0,1,2),label=c("Econômica","Ma
>> ster","Executiva"))
>>
>> dados=data.frame(sexo,surv,classe)
>>
>> s=table(dados$sexo);s
>> sp=round(prop.table(s)*100,2);sp
>>
>> Msexo=subset(dados,sexo=="Masculino")
>> cM=table(Msexo$classe);cM
>> cpM=round(prop.table(c)*100,2);cpM
>>
>> Fsexo=subset(dados,sexo=="Feminino")
>> cF=table(Fsexo$classe);cF
>> cpF=round(prop.table(c)*100,2);cpF
>>
>> Agradeço pela ajuda desde já.
>>
>> Abs.
>>
>>
>> _______________________________________________
>> R-br mailing list
>> R-br em listas.c3sl.ufpr.br
>> https://listas.inf.ufpr.br/cgi-bin/mailman/listinfo/r-br
>> Leia o guia de postagem (http://www.leg.ufpr.br/r-br-guia) e forneça
>> código mínimo reproduzível.
>>
>
>
-------------- Próxima Parte ----------
Um anexo em HTML foi limpo...
URL: <http://listas.inf.ufpr.br/pipermail/r-br/attachments/20160914/acc043ad/attachment.html>
Mais detalhes sobre a lista de discussão R-br