[R-br] Criação de um Fluxograma

Pedro Emmanuel Alvarenga Americano do Brasil emmanuel.brasil em gmail.com
Quarta Setembro 14 16:13:36 BRT 2016


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/78350f40/attachment.html>


Mais detalhes sobre a lista de discussão R-br