#' @title Gráfico das Condições Sensíveis à Atenção Primária
#' @description Desenha um gráfico de barras das CSAP por grupo de causa segundo a Lista Brasileira de Internações por Condições Sensíveis à Atenção Primária. Permite a lista oficial publicada em Portaria Ministerial, com 19 grupos de causa, ou a lista com 20 grupos, publicada por Alfradique et al.
#' @aliases desenhaCSAP
#'
#' @param dados O objeto com as informações a serem desenhadas. Pode ser: (ver \code{\link{descreveCSAP}})
#' \itemize{
#' \item Um \code{data.frame} gerado pela função \code{\link{csapAIH}}, ou qualquer \code{data.frame} com uma variável chamada \code{grupo} com os grupos de causa da Lista Brasileira de CSAP, rotulados na mesma forma que os resultantes da função \code{\link{csapAIH}}, isto é, "g01", "g02", ..., "g19".
#' \item Um objeto da classe \code{factor}) ou \code{character} com os grupos de causa CSAP, em ordem crescente de 1 a 19, conforme os grupos da Portaria do MS.
#' nomeados de acordo com o resultado da função \code{\link{csapAIH}}. Esse vetor não precisa ser gerado pela função \code{\link{csapAIH}}, mas os grupos também devem ser rotulados da mesma forma que na função, isto é, "g01", "g02", ..., "g19".
#' }
#' @param lista Lista de causas a ser considerada (v. detalhes); pode ser \code{"MS"} (padrão) para a lista publicada em portaria pelo Ministério da Saúde do Brasil ou "Alfradique" para a lista publicada no artigo de Alfradique et al.
#' @param lang idioma em que se apresentam os nomes dos grupos; pode ser: "pt.ca" (default) para nomes em português com acentos; "pt.sa" para nomes em português sem acentos; "en" para nomes em inglês; ou "es" para nomes em castelhano.
#' @param jaetabela Argumento lógico, cujo padrão é FALSE. TRUE indica que os dados são uma tabela pronta, que deve apenas ser graficada. A tabela pode ser um objeto de qualquer classe representando uma tabela com pelo menos duas colunas, sendo a primeira com uma identificação (não necessariamente o nome) do grupo CSAP conforme a Lista Brasileira e a segunda com o número de casos observado em cada grupo.
#' @param tipo.graf "ggplot" (padrão) cria um gráfico com \code{\link[ggplot2]{ggplot2}}; quando definido como "base", ou quando \code{\link[ggplot2]{ggplot2}} não está instalado, desenha um gráfico com as funções básicas.
#' @param valores Argumento utilizado nos gráficos com \code{\link[ggplot2]{ggplot2}}; "porcento" (padrão) desenha as barras em porcentagem, "contagem" as desenha em frequência absoluta. Veja em 'detalhes'.
#' @param ordenar Argumento lógico. Se \code{TRUE} (padrão), as barras do gráfico serão ordenadas de maior a menor frequência de casos.
#' @param colorir Argumento lógico ou para colorir as barras segundo demanda.
#' \itemize{
#' \item \code{TRUE} (padrão), colore as barras com a paleta \code{\link{rainbow}};
#' \item \code{FALSE}, mantém como \code{NULL} os argumentos para a cor das barras nas funções de origem do gráfico, isto é \code{\link[graphics]{barplot}(..., col = NULL, ...)} e \cr \code{\link[ggplot2]{geom_bar}(fill = NULL)}, colorindo as barras de \code{barplot} em cinza e de \code{ggplot} em preto;
#' \item \code{"cinza"} colore as barras em quatro tons de cinza de escuro a claro: os cinco grupos mais frequentes, os cinco seguintes, ..., os quatro últimos
#' \item Aceita um vetor (de comprimento igual ao nº de grupos de causa CSAP (o nº de \code{levels} na variável \code{grupos})) com os nomes ou códigos de cores.
#' }
#' @param porcentagens Argumento lógico, válido apenas para gráficos com ggplot. Se \code{TRUE} (padrão), as barras terão escritas sobre elas a porcentagem do grupo de causa sobre o total de internações (ou o total de internações no estrato, em gráficos com \code{\link[ggplot2]{facet_grid}} ou \code{\link[ggplot2]{facet_wrap}}).
#' @param val.dig Nº de decimais nos valores das barras; padrão é 0.
#' @param titulo Título do gráfico; se NULL (default), não é gerado um título; se \code{"auto"}, o argumento \code{onde} passa a ser obrigatório e a função gera um título para o gráfico a partir da informação de \code{onde} e do arquivo de dados ou do informado para o argumento \code{quando}. Se o argumento \code{dados} for um \code{factor} ou \code{character}, o argumento \code{quando} é obrigatório.
#' @param onde Local, população de origem dos dados do gráfico; obrigatório se \code{titulo = "auto"}.
#' @param quando Período de referência dos dados; se a fonte de dados for um "arquivo da AIH" (RD??????.dbc), é automaticamente extraído do arquivo.
#' @param t.hjust Valor para definição de ajuste horizontal do título, válido apenas para gráficos com ggplot. Default é 1.
#' @param t.size Valor para definição do tamanho de letra do título, válido apenas para gráficos com ggplot. Default é 12.
#' @param x.size Tamanho da letra do eixo x, válido apenas para gráficos com ggplot. Default é 10.
#' @param val.size Tamanho da letra dos valores das barras. Padrão é 2.5.
#' @param y.size Tamanho da letra do eixo y, válido apenas para gráficos com ggplot. Default é 12.
#' @param limsup Valor para ajuste do espaçamento do eixo de frequências, válido apenas para gráficos com ggplot. Quando o eixo representa porcentagens, deve ser expresso em proporção.
#' @param ... Permite o uso de argumentos de \code{\link{plot}} e \code{\link{barplot}}
#'
#' @return Na opção padrão e com \code{\link[ggplot2]{ggplot2}} instalado, devolve um objeto das classes "gg" e "ggplot", com o gráfico.
#' @details
#' Por padrão, o gráfico é desenhado com \code{\link[ggplot2]{ggplot2}}. Portanto, segue essa filosofia e permite a adição de outros comandos ao objeto devolvido. O vetor \code{grupos} não precisa ser gerado com a função \code{\link{csapAIH}}, mas deve usar os mesmos caracteres de identificação dos grupos CSAP que o resultado da função, v.g. "g01", "g02", ..., "g19".
#'
#' @seealso \code{\link{csapAIH}}, \code{\link{descreveCSAP}}, \code{\link[ggplot2]{ggplot}}, \code{\link{nomesgruposCSAP}}
#' @examples
#' library(csapAIH)
#' df <- csapAIH(aih100) # Computar as CSAP, lista MS
#'
#' # Gráficos com ggplot
#' # =====================
#'
#' # Cria o gráfico a partir do banco,
#' # uma vez que a variável com os grupos se chama "grupo":
#' # ----------------------------------------------------------
#' # Com titulo "automatico":
#' desenhaCSAP(df, titulo = "auto", onde = "Rio Grande do Sul")
#'
#' # Sem titulo e sem ordenacacao por frequencia:
#' desenhaCSAP(df, ordenar = FALSE)
#' #
#' # Com a lista de Alfradique et al.:
#' desenhaCSAP(csapAIH(aih100, "Alfradique"),
#' lista = "Alfradique",
#' titulo = "auto",
#' onde = "Rio Grande do Sul")
#' desenhaCSAP(csapAIH(aih100, "Alfradique"), lista = "Alfradique", lang = "es")
#'
#' # Cores
#' #-------
#' # Sem cores nas barras
#' desenhaCSAP(df, colorir = FALSE)
#'
#' # Com as barras em tons de cinza
#' desenhaCSAP(df, colorir = "cinza")
#'
#' # Com as barras em outra cor
#' desenhaCSAP(df, colorir = "yellow")
#' #
#' # Usando o banco todo pode-se tirar proveito de facilidades do ggplot2,
#' # como a reprodução do gráfico por estratos de outras variáveis, como no
#' # exemplo abaixo com o sexo. Para isso temos de descolorir o gráfico, que
#' # pode ser novamente colorido mais tarde. Como a ordenação dos grupos de
#' # causa continua sendo feita pela frequência da distribuição global, aqui
#' # ela faz menos sentido.
#' desenhaCSAP(df, ordenar = FALSE) +
#' ggplot2::facet_wrap(~sexo)
#'
#' # Cria o gráfico a partir de uma variável:
#' # ---------------------------------------
#' fator <- df$grupo
#' desenhaCSAP(fator)
#' carater <- as.character(fator)
#' desenhaCSAP(carater, limsup = 4.4)
#'
#' # Se \code{titulo = "auto"}, o argumento \code{quando} é obrigatório:
#' \dontrun{
#' desenhaCSAP(carater, titulo = "auto", onde = 'RS') # resulta em erro
#' }
#' desenhaCSAP(carater, titulo = "auto", onde = "RS", quando = "jan/2012")
#' desenhaCSAP(carater, titulo = "Título manual")
#'
#' # Cria o gráfico a partir de uma tabela com a primeira coluna contendo
#' # os 19 grupos de causa e a segunda coluna contendo o número de casos:
#' # --------------------------------------------------------------------
#' tabela <- descreveCSAP(df)
#' desenhaCSAP(tabela, jaetabela = TRUE)
#' \dontrun{
#' # Resulta em erro, faltou o argumento 'quando'
#' desenhaCSAP(tabela, jaetabela = TRUE, titulo = "auto", onde = 'RS')
#' }
#' desenhaCSAP(tabela, jaetabela = TRUE,
#' titulo = "auto", onde = "RS", quando = "jan/2012")
#' desenhaCSAP(tabela, jaetabela = TRUE, titulo = "Título manual")
#'
#' # Gráficos com as funções básicas
#' # =================================
#' desenhaCSAP(df, tipo.graf = "base", titulo = "dados = banco")
#' desenhaCSAP(df$grupo, tipo.graf = "base", titulo = "dados = fator")
#' desenhaCSAP(tabela, jaetabela = TRUE, tipo.graf = "base", titulo = "dados = tabela")
#'
#' @importFrom grDevices rainbow
#' @importFrom graphics barplot par
#' @importFrom stats reorder
#' @importFrom utils installed.packages
#' @export
#'
desenhaCSAP <- function(dados, lista = "MS", lang = "pt.ca", jaetabela = FALSE, tipo.graf = "ggplot", valores = "porcento", ordenar = TRUE, colorir = TRUE, porcentagens = TRUE, val.dig = 0, titulo = NULL, onde, quando = NULL, t.hjust = 1, t.size = 12, x.size = 10, y.size = 11, val.size = 2.5, limsup = NULL, ...){
if(lista == "MS") ngrupos = 19 else
if(lista == "Alfradique") ngrupos = 20
# Uma função -------------------
#
# Criar uma função pra arrumar os grupos de causa se
# a variável não tiver todos os grupos da lista.
#
arrumaniveis <- function(x) {
if (length(levels(x)) < 19) {
niveis <- c(paste0("g0", 1:9), paste0("g", 10:ngrupos))
x <- factor(x, levels = niveis)
x
} else
x
}
# --------------- termina função
# Arrumar esses casos
if (is.character(dados)) {
dados <- arrumaniveis(dados)
} else if (is.data.frame(dados)) {
if (is.character(dados$grupo)) {
dados$grupo <- arrumaniveis(dados$grupo)
}
}
#
# A tabela
# (cada vez mais acho que tenho de voltar ao table/tabulate,
# em vez de invocar a descreveCSAP)!
#
if(jaetabela == TRUE) {
tabela <- dados[1:ngrupos, 1:2]
} else {
tabela <- descreveCSAP(dados)[1:ngrupos, 1:2]
}
tabela[,2] <- as.numeric(gsub("\\.", "", tabela[,2]))
tabela <- droplevels(tabela[tabela$Casos > 0, ]) # para excluir grupos com frequência zero
ngrupos <- length(tabela$Grupo)
# - Título do gráfico ---------------------
#
if(!is.null(titulo)){
if(titulo == "auto"){
titulo1 <- "Hospitaliza\U00E7\U00E3o por Condi\U00E7\u00F5es Sens\U00EDveis \U00E0 Aten\U00E7\U00E3o Prim\U00E1ria."
if(is.null(quando)){
if("data.inter" %in% names(dados) == FALSE) {
stop("O argumento 'quando' \U00E9 obrigat\U00F3rio quando 'titulo' = 'auto' e o banco de dados n\U00E3o \U00E9 resultado da aplica\U00E7\U00E3o da fun\U00E7\U00E3o csapAIH sobre um arquivo da AIH. ")
}
quando <- format(sort(dados$data.inter, decreasing = TRUE)[1], "%B de %Y")
}
if(is.null(onde)) {
stop("O argumento 'onde' \U00E9 obrigat\U00F3rio quando 'titulo' = 'auto'. ")
}
titulo2 <- paste0(onde, ", ", quando, ".")
titulo <- paste(titulo1, "\n", titulo2)
}
}
# Cores das barras --------------------------
#
if (colorir == TRUE) {
cores = 1:ngrupos
} else if (colorir == FALSE) {
cores <- NULL
} else if (colorir == "cinza") { # criar uma paleta de cores para impressão em tons de cinza:
cores <- paste0("gray", c(rep(80, 4), rep(65, 5), rep(50, 5), rep(25, 5)))
cores <- cores[1:ngrupos]
} else {
cores <- colorir
}
# Gráfico com funções básicas ------------------------------
#
if(tipo.graf == 'base' | "ggplot2" %in% rownames(installed.packages()) == FALSE) {
# --- modo anterior ---
# x = tabulate(dados$grupo)[1:ngrupos]
# names(x) = csapAIH::groupnamesCSAP()
# names(x) <- Grupo
#
if(ordenar == TRUE) {
tabela <- tabela[order(tabela$Casos),]
}
if (colorir == TRUE) { # As cores das barras
cores = 1:ngrupos
} else if (colorir == FALSE) {
cores <- NULL
} else if (colorir == "cinza") {
# criar uma paleta de cores para impressão em tons de cinza:
cores <- paste0("gray", c(rep(80, 4), rep(65, 5), rep(50, 5), rep(25, 5)))
} else {
cores <- colorir
}
par(mar = c(5,15,4,2)) # As margens do gráfico
barplot(tabela$Casos, horiz = T, las = 1, col = cores, main = titulo, names.arg = tabela$Grupo, ...)
} #else {
if(tipo.graf == "ggplot") {
#
# - Gráfico com ggplot -----------
#
Grupo <- Casos <- grupo <- yrotulo <- prop <- count <- x <- NULL
#
# ----- Com uma tabela ------------------------------------------------
# Comandos exclusivos para desenhar a partir de variáveis isoladas
# ou tabelas prontas.
#
if (jaetabela == TRUE | !is.data.frame(dados)) {
# --- modo anterior ---
# df <- data.frame( "Grupo" = csapAIH::nomesgruposCSAP(),
# "Casos" = tabulate(dados$grupo)[1:ngrupos] )
# df <- data.frame(Grupo, Casos)
#
if(ordenar == TRUE) {
grafico <- ggplot2::ggplot(tabela,
ggplot2::aes(x = stats::reorder(Grupo, Casos),
y = Casos,
fill = rainbow(ngrupos) ))
} else {
grafico <- ggplot2::ggplot(tabela,
ggplot2::aes(x = Grupo,
y = Casos,
fill = rainbow(ngrupos) ))
}
grafico <- grafico +
ggplot2::geom_bar(stat = 'identity') +
ggplot2::geom_text(ggplot2::aes(label=paste0(round(Casos/sum(Casos)*100,1), '%')),
hjust=-.12, color="black", size=2.5)
} else {
# ----- Com o banco --------------------------------------------
# Comandos exclusivos para o gráfico usando todo o banco de dados
# O banco de dados
df <- droplevels(dados[dados$grupo != 'n\U00E3o-CSAP',])
# df$grupo <- arrumaniveis(df$grupo) # tem de aplicar novamente, pelo droplevels acima
levels(df$grupo) <- nomesgruposCSAP(lista = lista, lang = lang)[as.numeric(substr(levels(df$grupo), 2,3))] # Passa os nomes dos grupos
# df$grupo <- droplevels(df$grupo) # exclui grupos com frequência zero
ngrupos <- nlevels(df$grupo)
#
#
# Desenhar o gráfico
# -----------------------------------------------{kj}
# if(ordenar == TRUE) { # Ordem decrescente de frequência
protografico <-
ggplot2::ggplot(df,
ggplot2::aes(x = reorder(grupo, grupo, function(x) length(x)), group=1))
# } else
if (ordenar == FALSE) {
protografico <-
ggplot2::ggplot(df, ggplot2::aes(x = grupo, group = 1))
}
#
if(valores == "porcento") {
yrotulo <- "% entre as CSAP"
protografico <- protografico +
ggplot2::stat_count(ggplot2::aes(y = ggplot2::after_stat(prop))) +
# ggplot2::stat_count(ggplot2::aes(y = ggplot2::after_stat(prop), fill = factor(ggplot2::after_stat(x)))) +
ggplot2::scale_y_continuous(labels = function (x) paste(floor(x*100),"%"))
# ggplot2::scale_y_continuous(labels = scales::percent)
} else if (valores == "contagem") {
yrotulo <- "n\u00BA de casos"
protografico <- protografico +
ggplot2::stat_count(ggplot2::aes(y = ggplot2::after_stat(count)))
# ggplot2::stat_count(ggplot2::aes(y = ggplot2::after_stat(count), fill = factor(ggplot2::after_stat(x))))
}
#
# protografico <- protografico +
# ggplot2::theme(legend.position="none")
#
# Colorir as barras
# if (colorir == TRUE) { # As cores das barras
grafico <- protografico + ggplot2::aes(fill = factor(ggplot2::after_stat(x)))
# } #else
if (colorir == FALSE) {
grafico <- protografico +
ggplot2::aes(fill = "white", col = "black") +
ggplot2::scale_fill_identity(aesthetics = c("fill", "colour"))
} else if (colorir == "cinza") {
grafico <- grafico +
ggplot2::scale_fill_manual(values = cores, aesthetics = "fill")
} else if (colorir != "cinza" & colorir != TRUE & colorir != FALSE) {
grafico <- protografico +
ggplot2::aes(fill = cores, col = "black") +
ggplot2::scale_fill_identity(aesthetics = c("fill", "colour"))
# ggplot2::geom_bar(fill = colorir)
}
grafico <- grafico +
ggplot2::theme(legend.position="none")
#
# Colocar os valores
if (porcentagens == TRUE) { # As porcentagens
if (valores == "contagem"){
grafico <- grafico +
ggplot2::geom_text(ggplot2::aes(
label = scales::label_percent(ggplot2::after_stat(prop)), y = ggplot2::after_stat(count)), stat= "count",
hjust=-.12, color="black", size = val.size)
} else if (valores == "porcento") {
a <- c(1, .1, .01) # Define os decimais dos valores
val.dig <- 1 + val.dig # no gráfico
grafico <- grafico +
ggplot2::geom_text(ggplot2::aes(
label = scales::percent(ggplot2::after_stat(prop), accuracy = a[[val.dig]], decimal.mark = ","), y = ggplot2::after_stat(prop)), stat= "count",
hjust=-.12, color="black", size = val.size)
}
}
}
#
# Acabamentos -----------------------------------------------
#
grafico <- grafico +
ggplot2::coord_flip() +
ggplot2::xlab("Grupo de causas") +
ggplot2::ylab(yrotulo) +
ggplot2::ggtitle(titulo) +
ggplot2::theme_bw() +
ggplot2::theme(legend.position="none") +
ggplot2::theme(plot.title = ggplot2::element_text(hjust = t.hjust, size = t.size)) +
ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 60, hjust = 1, size = x.size),
axis.text.y = ggplot2::element_text(size = y.size))
if( !is.null(limsup) ) {
if(valores == "porcento") {
grafico <-
# suppressMessages(print(
grafico +
ggplot2::scale_y_continuous(labels = function (x) paste(floor(x*100),"%"),
limits = c(0, limsup))
# ))
} else
grafico <-
# suppressMessages(print(
grafico +
ggplot2::ylim(0, limsup)
# ) )
}
aih100 <- NULL # pra evitar a nota "no visible binding" ao rodar o exemplo
# return(grafico)
# if (colorir == "cinza") {
# grafico <- suppressMessages(grafico + ggplot2::scale_fill_manual(values = cores))
# }
grafico
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.