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 incluidostotal <- 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 positivocond <- which(b$v7 == "No")if(length(cond) > 0) {b <- b[-cond, ]}cond.semhiv <- total - cond.idade - nrow(b)# Assinou o TCLE v8cond <- 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 v9cond <- 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 v10cond <- 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 v11cond <- 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 v12cond <- 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 v13cond <- 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 diascond <- 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 <- NAfor(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))] > exclusaoTotal Didn't consent <NA> Age < 18 <NA>278 0 278 0 278HIV negative <NA> No cough and normal X-ray <NA> CD4+ > 20025 253 1 252 45<NA> Pregnancy <NA> No urine available <NA>207 0 207 1 206No 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::straightarrowplot.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 baloeselpos <- coordinates(coord)fromto <- matrix(ncol = 2, byrow = TRUE, data = ft)arrpos <- matrix(ncol = 2, nrow = nrow(fromto))# reduzindo as margenspar(mar=c(1,1,1,1))# Iniciando o graficorequire(diagram)openplotmat()# Colocando as setas no graficofor (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?ficofor(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 BrasilEm 14 de setembro de 2016 11:28, Abel Brasil Ramos da Silva via R-br <r-br@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|ExecutivaM---surv ||Econômica\--N --- classe |Master|Executivasex--||Econômica/--S --- classe |Master|ExecutivaF---surv ||Econômica\--N --- classe |Master|ExecutivaExemplo 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);ssp=round(prop.table(s)*100,2);sp Msexo=subset(dados,sexo=="Masculino") cM=table(Msexo$classe);cMcpM=round(prop.table(c)*100,2);cpM Fsexo=subset(dados,sexo=="Feminino") cF=table(Fsexo$classe);cFcpF=round(prop.table(c)*100,2);cpF Agradeço pela ajuda desde já.Abs._________________
R-br mailing list
R-br@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.