Carregamento das Bibliotecas

library(knitr)
library(readxl)
library(lubridate)
library(tidyverse)
library(DescTools)

# Set das variáveis de ambiente
setwd("~/Dropbox/Coding/R/")
Sys.setenv(TZ="Brazil/East")
options(tz="Brazil/East")
Sys.getenv("TZ")
## [1] "Brazil/East"
Sys.setlocale("LC_TIME", "pt_BR")
## [1] "pt_BR"
options(scipen = 9999)

Exercício 02

Importar o banco para o R

Atribuir levels dos fatores e missings.

# carregamento do Banco na Variável trabalho
trabalho <- read_excel("~/Dropbox/AaZ/M/Mestrado/Aulas/2019-01/EPI67 - Introdução ao SPSS, SAS e R/trabalho/data/trabalho.xlsx")
# Total de internações
nrow(trabalho)
## [1] 5027
# Identificaçõa de casos únicos
length(unique(trabalho$PRONTUARIO))
## [1] 4074

Conversão de variáveis

# Ajuste das variáveis contínuas
trabalho$PESO <- as.numeric(trabalho$PESO)
trabalho$ALTURA <- as.numeric(trabalho$ALTURA)

# Ajuste de missings
trabalho$ESCOLARIDADE[trabalho$ESCOLARIDADE == "ignorado"] <- NA

# Ajuste das variáveis discretas
trabalho$ETNIA <- factor(trabalho$ETNIA)
trabalho$ESTADO_CIVIL <- factor(trabalho$ESTADO_CIVIL)
trabalho$GENERO <-  factor(trabalho$GENERO)
trabalho$ESCOLARIDADE <- factor(trabalho$ESCOLARIDADE)
trabalho$ESP_INTERNOU <- factor(trabalho$ESP_INTERNOU)

trabalho$ESCALA_GRAVIDADE[trabalho$ESCALA_GRAVIDADE == "Box M"] <- "Emergencia"
trabalho$ESCALA_GRAVIDADE <- factor(trabalho$ESCALA_GRAVIDADE, 
                                    ordered = TRUE,
                                    levels = c("Emergencia", "Muito Urgente", 
                                               "Urgente", "Pouco Urgente", "Não Urgente", "Sem Classificação"))
trabalho$OBITO <- if_else(is.na(trabalho$OBITO), "Não óbito", "Óbito")
trabalho$OBITO <- factor(trabalho$OBITO)



# Ajuste das datas
trabalho$DT_NASCIMENTO <- date(dmy_hms(trabalho$DT_NASCIMENTO))
trabalho$DT_CHEGADA_EMERG <- (dmy(trabalho$DT_CHEGADA_EMERG))
glimpse(trabalho)
## Observations: 5,027
## Variables: 15
## $ PRONTUARIO       <dbl> 11537388, 14229678, 14299994, 13682919, 9283128…
## $ ETNIA            <fct> BRANCA, PARDA, BRANCA, PRETA, PARDA, PARDA, BRA…
## $ ESTADO_CIVIL     <fct> Viúvo, Solteiro, Solteiro, Casado, Viúvo, Viúvo…
## $ GENERO           <fct> F, M, F, F, F, F, F, F, F, F, M, F, M, F, F, F,…
## $ DT_NASCIMENTO    <date> 1930-06-04, 1927-09-24, 1934-10-12, 1946-09-01…
## $ ESCOLARIDADE     <fct> NA, 1o grau incompleto, nenhum, 1o grau complet…
## $ DT_CHEGADA_EMERG <date> 2018-08-24, 2018-03-12, 2018-05-31, 2017-01-24…
## $ ESP_INTERNOU     <fct> URGENCIA ADULTO, TRATAMENTO INTENSIVO ADULTO, U…
## $ ESCALA_GRAVIDADE <ord> Emergencia, Muito Urgente, Muito Urgente, Muito…
## $ BRADEN           <dbl> 7, 7, 7, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,…
## $ MORSE            <dbl> 35, 60, 35, 50, 35, 35, 35, 35, 35, 50, 35, 35,…
## $ OBITO            <fct> Óbito, Óbito, Óbito, Óbito, Óbito, Óbito, Óbito…
## $ PERMANENCIA      <dbl> 4, 8, 2, 1, 10, 20, 7, 11, 20, 11, 10, 8, 13, 9…
## $ PESO             <dbl> 56.1, 95.5, 76.0, 51.8, 58.0, 87.1, 71.5, 68.6,…
## $ ALTURA           <dbl> 163.8, 165.9, 172.4, 159.2, 169.0, 188.6, 182.5…

Cálculo da variável idade calculada (idade_calc)

trabalho$idade_calc <- as.numeric(difftime(time1 = trabalho$DT_CHEGADA_EMERG,time2 = trabalho$DT_NASCIMENTO,units = "days")) / 365.242

Ajuste da variável especialidade que internou

trabalho$ESP_INTERNOU <- case_when(
  trabalho$ESP_INTERNOU == "TRATAMENTO INTENSIVO ADULTO" ~ "UTI",
  trabalho$ESP_INTERNOU == "URGENCIA ADULTO" ~ "EMERGENCIA",
  TRUE ~ "Outros"
)

# Conversão da variável ESP_INTERNOU em fator
trabalho$ESP_INTERNOU <- factor(trabalho$ESP_INTERNOU)

Exercício 3

Criar uma nova variável a partir da categorização em quartis de uma variável quantitativa.

trabalho$idade_quartis <- cut(trabalho$idade_calc, breaks = quantile(trabalho$idade_calc))
table(trabalho$idade_quartis)
## 
##   (19,54.8] (54.8,65.3] (65.3,74.5]  (74.5,103] 
##        1256        1258        1255        1257

Exercício 4

Criar uma nova variável a partir de recategorização de uma variável categórica ou categorização de uma variável quantitativa em faixas pré-definidas.

Categorização de uma variável quantitativa em faixas pré-definidas.

Criamos a variável braden_cat (Bradem categorizada), utilizando a função if_else

  • 1 = pacientes com risco de desenvolvimento de lesão por pressão
  • 2 = pacientes sem risco de desenvolvimento de lesão por pressão
# Criação da variável braden_cat
trabalho$braden_cat <- if_else(trabalho$BRADEN <= 18,1, 2)
trabalho$braden_cat <- factor(trabalho$braden_cat,levels = c(1,2),
                              labels = c("pacientes com risco de desenvolvimento de lesão por pressão",
                                         "pacientes sem risco de desenvolvimento de lesão por pressão"))

Categorização de uma variável quantitativa em faixas pré-definidas.

Criamos a variável morse_cat (Morse categorizada), utilizando a função cut

# Criação da varíavel morse_cat
trabalho$morse_cat <- cut(x = trabalho$MORSE,breaks = c(0,44,Inf),
    include.lowest = TRUE,
    labels = c("pacientes sem risco de quedas", "pacientes com risco de quedas") )
table(trabalho$morse_cat)
## 
## pacientes sem risco de quedas pacientes com risco de quedas 
##                          1778                          2065

Categorização de uma variável quantitativa em faixas pré-definidas.

Criamos a variável permanencia_cat (Tempo de Permanência categorizado): * Até 07 dias internação normal * Mais do que 07 dias internação prolongada

trabalho$permanencia_cat <- cut(x = trabalho$PERMANENCIA,
                                breaks = c(0,7,Inf),
                                include.lowest = TRUE,
                                labels = c("Menor que 7 dias", "Internação prolongada - Maior que 7 dias")
                                )

Exercício 5

Criar uma nova variável a partir de operações aritméticas com uma ou mais variáveis quantitativas.

trabalho <- trabalho %>% 
  mutate(imc = PESO / (ALTURA / 100)^2)

Exercício 6

Fazer a análise descritiva univariada de todas as variáveis.

Etnia

# ETNIA
Desc(trabalho$ETNIA, digits = 2)
## ------------------------------------------------------------------------- 
## trabalho$ETNIA (factor)
## 
##   length      n    NAs unique levels  dupes
##    5'027  5'026      1      4      4      y
##          100.0%   0.0%                     
## 
##      level   freq    perc  cumfreq  cumperc
## 1   BRANCA  4'288  85.32%    4'288   85.32%
## 2    PRETA    530  10.55%    4'818   95.86%
## 3    PARDA    206   4.10%    5'024   99.96%
## 4  AMARELA      2   0.04%    5'026  100.00%

summary(trabalho$ETNIA)
## AMARELA  BRANCA   PARDA   PRETA    NA's 
##       2    4288     206     530       1

Estado Civíl

# ESTADO_CIVIL
Desc(trabalho$ESTADO_CIVIL, digits = 2)
## ------------------------------------------------------------------------- 
## trabalho$ESTADO_CIVIL (factor)
## 
##   length      n    NAs unique levels  dupes
##    5'027  5'027      0      6      6      y
##          100.0%   0.0%                     
## 
##         level   freq    perc  cumfreq  cumperc
## 1      Casado  2'276  45.28%    2'276   45.28%
## 2    Solteiro  1'565  31.13%    3'841   76.41%
## 3       Viúvo    680  13.53%    4'521   89.93%
## 4  Divorciado    294   5.85%    4'815   95.78%
## 5    Separado    187   3.72%    5'002   99.50%
## 6      Outros     25   0.50%    5'027  100.00%

Gênero

Desc(trabalho$GENERO, digits = 2)
## ------------------------------------------------------------------------- 
## trabalho$GENERO (factor - dichotomous)
## 
##   length      n    NAs unique
##    5'027  5'027      0      2
##          100.0%   0.0%       
## 
##     freq    perc  lci.95  uci.95'
## F  2'412  47.98%  46.60%  49.36%
## M  2'615  52.02%  50.64%  53.40%
## 
## ' 95%-CI Wilson

Escolaridade

# ESCOLARIDADE
Desc(trabalho$ESCOLARIDADE, digits = 2)
## ------------------------------------------------------------------------- 
## trabalho$ESCOLARIDADE (factor)
## 
##   length      n    NAs unique levels  dupes
##    5'027  4'656    371      7      7      y
##           92.6%   7.4%                     
## 
##                  level   freq    perc  cumfreq  cumperc
## 1   1o grau incompleto  2'273  48.82%    2'273   48.82%
## 2     1o grau completo    903  19.39%    3'176   68.21%
## 3     2o grau completo    762  16.37%    3'938   84.58%
## 4               nenhum    263   5.65%    4'201   90.23%
## 5   2o grau incompleto    191   4.10%    4'392   94.33%
## 6             superior    179   3.84%    4'571   98.17%
## 7  superior incompleto     85   1.83%    4'656  100.00%

Especialidade que internou

Desc(trabalho$ESP_INTERNOU, digits = 2)
## ------------------------------------------------------------------------- 
## trabalho$ESP_INTERNOU (factor)
## 
##   length      n    NAs unique levels  dupes
##    5'027  5'027      0      3      3      y
##          100.0%   0.0%                     
## 
##         level   freq    perc  cumfreq  cumperc
## 1  EMERGENCIA  3'743  74.46%    3'743   74.46%
## 2         UTI  1'105  21.98%    4'848   96.44%
## 3      Outros    179   3.56%    5'027  100.00%

Escala de Gravidade

Desc(trabalho$ESCALA_GRAVIDADE, digits = 2)
## ------------------------------------------------------------------------- 
## trabalho$ESCALA_GRAVIDADE (ordered, factor)
## 
##   length      n    NAs unique levels  dupes
##    5'027  5'027      0      6      6      y
##          100.0%   0.0%                     
## 
##                level   freq    perc  cumfreq  cumperc
## 1         Emergencia    317   6.31%      317    6.31%
## 2      Muito Urgente  3'504  69.70%    3'821   76.01%
## 3            Urgente  1'200  23.87%    5'021   99.88%
## 4      Pouco Urgente      3   0.06%    5'024   99.94%
## 5        Não Urgente      2   0.04%    5'026   99.98%
## 6  Sem Classificação      1   0.02%    5'027  100.00%

Escala de Braden (numérica)

# BRADEN
Desc(trabalho$BRADEN, digits = 2)
## ------------------------------------------------------------------------- 
## trabalho$BRADEN (numeric)
## 
##   length      n    NAs  unique     0s   mean  meanCI
##    5'027  3'852  1'175      17      0  17.05   16.94
##           76.6%  23.4%           0.0%          17.17
##                                                     
##      .05    .10    .25  median    .75    .90     .95
##    11.00  12.00  14.00   18.00  20.00  21.00   22.00
##                                                     
##    range     sd  vcoef     mad    IQR   skew    kurt
##    16.00   3.67   0.21    4.45   6.00  -0.45   -0.87
##                                                     
## lowest : 7.00 (3), 8.00 (21), 9.00 (60), 10.00 (96), 11.00 (153)
## highest: 19.00 (378), 20.00 (491), 21.00 (479), 22.00 (296), 23.00 (34)

Escala de Morse (Numérica)

Desc(trabalho$MORSE, digits = 2)
## ------------------------------------------------------------------------- 
## trabalho$MORSE (numeric)
## 
##   length      n    NAs  unique     0s   mean  meanCI
##    5'027  3'843  1'184      28     10  47.09   46.56
##           76.4%  23.6%           0.2%          47.62
##                                                     
##      .05    .10    .25  median    .75    .90     .95
##    35.00  35.00  35.00   45.00  60.00  75.00   75.00
##                                                     
##    range     sd  vcoef     mad    IQR   skew    kurt
##   125.00  16.72   0.36   14.83  25.00   0.95    1.15
##                                                     
## lowest : 0.00 (10), 3.00, 10.00, 15.00 (69), 16.00
## highest: 100.00 (33), 105.00 (2), 110.00 (2), 115.00 (7), 125.00 (2)

Óbito

Desc(trabalho$OBITO, digits = 2)
## ------------------------------------------------------------------------- 
## trabalho$OBITO (factor - dichotomous)
## 
##   length      n    NAs unique
##    5'027  5'027      0      2
##          100.0%   0.0%       
## 
##             freq    perc  lci.95  uci.95'
## Não óbito  3'206  63.78%  62.44%  65.09%
## Óbito      1'821  36.22%  34.91%  37.56%
## 
## ' 95%-CI Wilson

Tempo de Permanência

Desc(trabalho$PERMANENCIA, na.rm = T, digits = 2)
## ------------------------------------------------------------------------- 
## trabalho$PERMANENCIA (numeric)
## 
##   length      n    NAs  unique     0s   mean  meanCI
##    5'027  5'017     10     124      6  18.67   18.15
##           99.8%   0.2%           0.1%          19.18
##                                                     
##      .05    .10    .25  median    .75    .90     .95
##     3.00   4.00   7.00   13.00  23.00  39.00   52.00
##                                                     
##    range     sd  vcoef     mad    IQR   skew    kurt
##   295.00  18.74   1.00   10.38  16.00   3.74   27.00
##                                                     
## lowest : 0.00 (6), 1.00 (58), 2.00 (78), 3.00 (154), 4.00 (213)
## highest: 201.00, 203.00, 216.00, 235.00, 295.00

Peso (em kg)

Desc(trabalho$PESO, digits = 2)
## ------------------------------------------------------------------------- 
## trabalho$PESO (numeric)
## 
##   length       n    NAs  unique     0s   mean  meanCI
##    5'027   5'027      0     643      0  74.43   74.04
##           100.0%   0.0%           0.0%          74.83
##                                                      
##      .05     .10    .25  median    .75    .90     .95
##    53.00   56.30  63.50   73.40  84.10  93.70   99.50
##                                                      
##    range      sd  vcoef     mad    IQR   skew    kurt
##    83.70   14.25   0.19   15.12  20.60   0.43   -0.19
##                                                      
## lowest : 48.50 (3), 48.60 (4), 48.70 (5), 48.80 (5), 48.90 (5)
## highest: 126.70, 126.90, 127.80, 129.00, 132.20

Altura (em cm)

Desc(trabalho$ALTURA, digits = 2)
## ------------------------------------------------------------------------- 
## trabalho$ALTURA (numeric)
## 
##   length       n     NAs  unique      0s    mean  meanCI
##    5'027   5'027       0     521       0  170.91  170.59
##           100.0%    0.0%            0.0%          171.23
##                                                         
##      .05     .10     .25  median     .75     .90     .95
##   152.90  155.80  162.10  170.50  179.00  186.50  191.37
##                                                         
##    range      sd   vcoef     mad     IQR    skew    kurt
##    53.90   11.54    0.07   12.45   16.90    0.28   -0.49
##                                                         
## lowest : 149.00 (6), 149.10 (7), 149.20 (8), 149.30 (2), 149.40 (8)
## highest: 202.10, 202.20 (5), 202.70 (2), 202.80 (4), 202.90

Idade Calculada

Desc(trabalho$idade_calc, digits = 2)
## ------------------------------------------------------------------------- 
## trabalho$idade_calc (numeric)
## 
##   length       n    NAs  unique     0s   mean  meanCI
##    5'027   5'027      0   4'474      0  63.52   63.09
##           100.0%   0.0%           0.0%          63.96
##                                                      
##      .05     .10    .25  median    .75    .90     .95
##    32.56   41.58  54.79   65.25  74.51  82.68   86.52
##                                                      
##    range      sd  vcoef     mad    IQR   skew    kurt
##    83.70   15.79   0.25   14.73  19.72  -0.55    0.05
##                                                      
## lowest : 19.01, 19.03, 19.04, 19.17, 19.17
## highest: 98.93, 98.99, 99.16, 101.75, 102.71

Idade em Quartis

Desc(trabalho$idade_quartis, digits = 2)
## ------------------------------------------------------------------------- 
## trabalho$idade_quartis (factor)
## 
##   length      n    NAs unique levels  dupes
##    5'027  5'026      1      4      4      y
##          100.0%   0.0%                     
## 
##          level   freq    perc  cumfreq  cumperc
## 1  (54.8,65.3]  1'258  25.03%    1'258   25.03%
## 2   (74.5,103]  1'257  25.01%    2'515   50.04%
## 3    (19,54.8]  1'256  24.99%    3'771   75.03%
## 4  (65.3,74.5]  1'255  24.97%    5'026  100.00%

Escala de Braden Categorizada

Desc(trabalho$braden_cat, digits = 2)
## ------------------------------------------------------------------------- 
## trabalho$braden_cat (factor - dichotomous)
## 
##   length      n    NAs unique
##    5'027  3'852  1'175      2
##           76.6%  23.4%       
## 
##                                                               freq    perc'
## pacientes com risco de desenvolvimento de lesão por pressão  2'174  56.44%
## pacientes sem risco de desenvolvimento de lesão por pressão  1'678  43.56%
##                                                              lci.95
## pacientes com risco de desenvolvimento de lesão por pressão  54.87%
## pacientes sem risco de desenvolvimento de lesão por pressão  42.00%
##                                                              uci.95
## pacientes com risco de desenvolvimento de lesão por pressão  58.00%
## pacientes sem risco de desenvolvimento de lesão por pressão  45.13%
## 
## ' 95%-CI Wilson

Escala de Morse Categorizada

Desc(trabalho$morse_cat, digits = 2)
## ------------------------------------------------------------------------- 
## trabalho$morse_cat (factor - dichotomous)
## 
##   length      n    NAs unique
##    5'027  3'843  1'184      2
##           76.4%  23.6%       
## 
##                                 freq    perc  lci.95  uci.95'
## pacientes sem risco de quedas  1'778  46.27%  44.69%  47.85%
## pacientes com risco de quedas  2'065  53.73%  52.15%  55.31%
## 
## ' 95%-CI Wilson

Tempo de Permanência Categorizado (> ou < 7 dias)

Desc(trabalho$permanencia_cat, digits = 2)
## ------------------------------------------------------------------------- 
## trabalho$permanencia_cat (factor - dichotomous)
## 
##   length      n    NAs unique
##    5'027  5'017     10      2
##           99.8%   0.2%       
## 
##                                            freq    perc  lci.95  uci.95'
## Menor que 7 dias                          1'282  25.55%  24.37%  26.78%
## Internação prolongada - Maior que 7 dias  3'735  74.45%  73.22%  75.63%
## 
## ' 95%-CI Wilson

Índice de massa corporal

Desc(trabalho$imc, digits = 2)
## ------------------------------------------------------------------------- 
## trabalho$imc (numeric)
## 
##   length       n    NAs  unique     0s   mean  meanCI
##    5'027   5'027      0   4'961      0  25.83   25.67
##           100.0%   0.0%           0.0%          26.00
##                                                      
##      .05     .10    .25  median    .75    .90     .95
##    17.01   18.41  21.37   25.14  29.71  34.14   37.00
##                                                      
##    range      sd  vcoef     mad    IQR   skew    kurt
##    39.24    6.11   0.24    6.06   8.34   0.60    0.22
##                                                      
## lowest : 12.62, 12.79, 12.95, 12.95, 13.01
## highest: 49.76, 50.43, 50.87, 51.22, 51.86

Gráficos das Variáveis Univariadas

Histograma do Peso (em kg)

trabalho %>% 
  ggplot(aes(x = PESO)) + geom_histogram() + ylab("Quantidade") + xlab("Peso (kg)")

Histograma da Altura (em cm)

trabalho %>% 
  ggplot(aes(x = ALTURA)) + geom_histogram() + ylab("Quantidade") + xlab("Altura (cm)")
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Gráfico de barras da Variável Braden Categorizada

trabalho %>% 
  filter(!is.na(braden_cat)) %>% 
  group_by(braden_cat) %>%
  summarise(Quantidade = n()) %>% 
  mutate(prop = paste0(format(Quantidade / sum(Quantidade) * 100, digits = 4), " %")) %>% 
  ggplot(aes(x = braden_cat, y = Quantidade, fill = as.factor(Quantidade), label = prop)) + geom_col() + ylab("Quantidade") + 
  xlab("Categorias de risco") + theme(legend.position = "none") + geom_label()

Gráfico de barras da Variável Morse Categorizada

trabalho %>% 
  filter(!is.na(morse_cat)) %>% 
  group_by(morse_cat) %>%
  summarise(Quantidade = n()) %>% 
  mutate(prop = paste0(format(Quantidade / sum(Quantidade) * 100, digits = 4), " %")) %>% 
  ggplot(aes(x = morse_cat, y = Quantidade, fill = as.factor(Quantidade), label = prop)) + geom_col() + ylab("Quantidade") + 
  xlab("Categorias de risco") + theme(legend.position = "none") + geom_label()

Exercício 7

Fazer pelo menos uma análise descritiva bivariada de cada tipo de cruzamento: quantitativa X quantitativa, qualitativa X qualitativa, qualitativa X quantitativa.

Gráfico de dispersão do tempo de permanência x idade dos pacientes que não foram a óbito
bivar1_n_obito <- trabalho %>% 
  filter(OBITO == "Não óbito")

Desc(PERMANENCIA ~ idade_calc, data = bivar1_n_obito,)
## ------------------------------------------------------------------------- 
## PERMANENCIA ~ idade_calc
## 
## Summary: 
## n pairs: 3'206, valid: 3'196 (99.7%), missings: 10 (0.3%)
## 
## 
## Pearson corr. : -0.125
## Spearman corr.: -0.164
## Kendall corr. : -0.112

trabalho %>% 
  filter(OBITO == "Não óbito") %>% 
  ggplot(aes(x = idade_calc, y = PERMANENCIA)) + geom_point(alpha = 0.2) +
  ylab("Permanência") + xlab("Idade") + geom_smooth(method = "lm")
## Warning: Removed 10 rows containing non-finite values (stat_smooth).
## Warning: Removed 10 rows containing missing values (geom_point).

cor.test(x = bivar1_n_obito$idade_calc, y = bivar1_n_obito$PERMANENCIA, method = "pearson")
## 
##  Pearson's product-moment correlation
## 
## data:  bivar1_n_obito$idade_calc and bivar1_n_obito$PERMANENCIA
## t = -7.1051, df = 3194, p-value = 0.000000000001477
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.1587220 -0.0904564
## sample estimates:
##        cor 
## -0.1247368
Gráfico de dispersão do tempo de permanência x idade dos pacientes que foram a óbito
bivar2_obitos <- trabalho %>% 
  filter(OBITO == "Óbito")

Desc(PERMANENCIA ~ idade_calc,data = bivar2_obitos)
## ------------------------------------------------------------------------- 
## PERMANENCIA ~ idade_calc
## 
## Summary: 
## n pairs: 1'821, valid: 1'821 (100.0%), missings: 0 (0.0%)
## 
## 
## Pearson corr. : -0.150
## Spearman corr.: -0.156
## Kendall corr. : -0.106

trabalho %>% 
  filter(OBITO == "Óbito") %>% 
  ggplot(aes(x = idade_calc, y = PERMANENCIA)) + geom_point(alpha = 0.2) +
  ylab("Permanência") + xlab("Idade") + geom_smooth(method = "lm")

cor.test(x = bivar2_obitos$idade_calc, y = bivar2_obitos$PERMANENCIA, method = "pearson")
## 
##  Pearson's product-moment correlation
## 
## data:  bivar2_obitos$idade_calc and bivar2_obitos$PERMANENCIA
## t = -6.4588, df = 1819, p-value = 0.0000000001351
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.1943300 -0.1045151
## sample estimates:
##        cor 
## -0.1497314
trabalho %>% 
  mutate(total = n()) %>% 
  group_by(ESCALA_GRAVIDADE, OBITO, total) %>%
  summarise(n = n()) %>%
  mutate(Percentual = paste0(format(n / total* 100, digits = 4), " %")) %>% 
  ggplot(aes(x = ESCALA_GRAVIDADE, y = n, fill= OBITO, label = Percentual)) + geom_col() +
  ylab("Quantidade") + xlab("Classificação de Risco") + geom_label()

trabalho %>% 
  filter(!is.na(braden_cat)) %>% 
  group_by(ESCALA_GRAVIDADE, OBITO) %>%
  summarise(n = n()) %>% 
  mutate(Percentual = n / sum(n))
## # A tibble: 9 x 4
## # Groups:   ESCALA_GRAVIDADE [6]
##   ESCALA_GRAVIDADE  OBITO         n Percentual
##   <ord>             <fct>     <int>      <dbl>
## 1 Emergencia        Não óbito   115      0.646
## 2 Emergencia        Óbito        63      0.354
## 3 Muito Urgente     Não óbito  1723      0.644
## 4 Muito Urgente     Óbito       951      0.356
## 5 Urgente           Não óbito   712      0.715
## 6 Urgente           Óbito       284      0.285
## 7 Pouco Urgente     Não óbito     2      1    
## 8 Não Urgente       Não óbito     1      1    
## 9 Sem Classificação Não óbito     1      1
# Crosstab da escala de prioridade x obitos
table(trabalho$ESCALA_GRAVIDADE, trabalho$OBITO)
##                    
##                     Não óbito Óbito
##   Emergencia              161   156
##   Muito Urgente          2198  1306
##   Urgente                 842   358
##   Pouco Urgente             2     1
##   Não Urgente               2     0
##   Sem Classificação         1     0
format(prop.table(table(trabalho$ESCALA_GRAVIDADE, trabalho$OBITO))*100, digits = 2)
##                    
##                     Não óbito Óbito  
##   Emergencia        " 3.20"   " 3.10"
##   Muito Urgente     "43.72"   "25.98"
##   Urgente           "16.75"   " 7.12"
##   Pouco Urgente     " 0.04"   " 0.02"
##   Não Urgente       " 0.04"   " 0.00"
##   Sem Classificação " 0.02"   " 0.00"
trabalho %>% 
  filter(!is.na(morse_cat)) %>% 
  group_by(OBITO, morse_cat) %>%
  summarise(n = n()) %>% 
  mutate(Percentual = paste0(format(n / sum(n)*100, digits = 4), " %")) %>% 
  ggplot(aes(x = morse_cat, y = n, fill= OBITO, label = Percentual)) + geom_col() +
  ylab("Quantidade") + xlab("Classificação de Risco") + geom_label()

trabalho %>% 
  filter(!is.na(braden_cat)) %>% 
  group_by(OBITO, braden_cat) %>%
  summarise(n = n()) %>% 
  mutate(Percentual = paste0(format(n / sum(n)*100, digits = 4), " %")) %>% 
  ggplot(aes(x = braden_cat, y = n, fill= OBITO, label = Percentual)) + geom_col() +
  ylab("Quantidade") + xlab("Classificação de Risco") + geom_label()

trabalho %>% 
  filter(!is.na(PERMANENCIA)) %>% 
  filter(OBITO == "Não óbito") %>% 
  ggplot(aes(x = PERMANENCIA)) + geom_histogram() +
  ylab("Quantidade") + xlab("Tempo de permanência em dias")
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

trabalho %>% 
  ggplot(aes(x = OBITO, y =PERMANENCIA, fill = OBITO)) +geom_boxplot() +
  ylab("Tempo de permanência") + xlab("Obito") + theme(legend.position = "none")
## Warning: Removed 10 rows containing non-finite values (stat_boxplot).