Dados Categóricos

Exercícios do Cap.2 (pág 38) - exercício 3

# dados da Tabela 1.9
dad <- data.frame(sexo = rep(c("masculino", "feminino"), each = 2),
                  anormalidade = rep(c("presente", "ausente"), 2),
                  f = c(14, 12, 12, 1))
dad
##        sexo anormalidade  f
## 1 masculino     presente 14
## 2 masculino      ausente 12
## 3  feminino     presente 12
## 4  feminino      ausente  1

tabela de contingência 2x2

tab <- xtabs(f ~ sexo + anormalidade, data=dad)

addmargins(tab)
##            anormalidade
## sexo        ausente presente Sum
##   feminino        1       12  13
##   masculino      12       14  26
##   Sum            13       26  39

novo arquivo de dados para fazer os gráficos

dad <- data.frame(x = c("masculino e presente",
                        "masculino e ausente",
                        "feminino e presente",
                        "feminino e ausente"),
                  f = c(14, 12, 12, 1))
dad <- dad %>% mutate(p = f/sum(f))
dad
##                      x  f          p
## 1 masculino e presente 14 0,35897436
## 2  masculino e ausente 12 0,30769231
## 3  feminino e presente 12 0,30769231
## 4   feminino e ausente  1 0,02564103

gráfico de colunas

ggplot(dad, aes(x = x, y = p, fill = x)) +
   geom_col(position = "dodge") + ylim(c(0, 0.5)) +
   theme(legend.position = "top") +
   labs(x = "", y = "Proporções amostrais",
        fill = "", title = "Gráfico de colunas") +
   geom_text(aes(label = round(p, 3)), vjust = 1.5) +
   guides(fill = "none")

gráfico de setores

ggplot(dad, aes(x = "", y = p, fill = x)) +
  geom_col(color = "black") +
  coord_polar(theta = "y") +
  theme_void() +
  geom_text(aes(label = round(p, 3)),
  position = position_stack(vjust = 0.5)) +
  guides(fill = guide_legend(title = "Classificações")) +
  ggtitle("Gráfico de setores")

ex 4 - dados da Tabela 1.10

dad <- data.frame(status = rep(c("fumante", "não fumante"), each = 2),
                  cancer = rep(c("sim", "não"), 2),
                  f = c(90, 710, 10, 1190))
dad
##        status cancer    f
## 1     fumante    sim   90
## 2     fumante    não  710
## 3 não fumante    sim   10
## 4 não fumante    não 1190

tabela de contingência 2x2

tab <- xtabs(f ~ status + cancer, data=dad)

addmargins(tab)
##              cancer
## status         não  sim  Sum
##   fumante      710   90  800
##   não fumante 1190   10 1200
##   Sum         1900  100 2000

acrescentando aos dados as proporções de acordo com o modelo para fazer os gráficos

dad <- dad %>% group_by(status) %>% mutate(p = f/sum(f)) %>%
   ungroup()
dad
## # A tibble: 4 × 4
##   status      cancer     f       p
##   <chr>       <chr>  <dbl>   <dbl>
## 1 fumante     sim       90 0.112  
## 2 fumante     não      710 0.888  
## 3 não fumante sim       10 0.00833
## 4 não fumante não     1190 0.992

gráfico de colunas múltiplas

ggplot(dad, aes(x = status, y = p, fill = cancer)) +
   geom_col(position = "dodge") + ylim(c(0, 1)) +
   theme(legend.position = "top") +
   labs(x = "Exposição ao fator", y = "Proporções amostrais",
        fill = "", title = "Gráfico de colunas múltiplas") +
   geom_text(aes(label = round(p, 3)), vjust = 1,
             position = position_dodge(.9))

gráfico de colunas segmentadas

ggplot(dad, aes(x = status, y = p, fill = cancer)) +
   geom_col() + ylim(c(0, 1)) +
   theme(legend.position = "top") +
   labs(x = "Exposição ao fator", y = "Proporções amostrais",
        fill = "", title = "Gráfico de colunas segmentadas") +
   geom_text(aes(label = round(p, 3)),
             position = position_stack(vjust=.8))

gráfico de barras múltiplas

ggplot(dad, aes(x = status, y = p, fill = cancer)) +
   geom_col(position = "dodge") + ylim(c(0, 1)) +
   theme(legend.position = "top") +
   labs(x = "Tratamentos", y = "Proporções amostrais",
        fill = "", title = "Gráfico de barras múltiplas") +
   geom_text(aes(label = round(p, 3)), hjust = .5,
             position = position_dodge(.9)) +
   coord_flip()

gráfico de barras segmentadas

ggplot(dad, aes(x = status, y = p, fill = cancer)) +
   geom_col() + ylim(c(0, 1)) +
   theme(legend.position = "top") +
   labs(x = "Grupos", y = "Proporções amostrais",
        fill = "", title = "Gráfico de barras segmentadas") +
   geom_text(aes(label = round(p, 3)), hjust = 0,
             position = position_stack()) +
   coord_flip()

dados da Tabela 1.11

dad <- data.frame(historico = rep(c("sim", "não"), each = 2),
                  cancer = rep(c("sim", "não"), 2),
                  f = c(17, 36, 8, 102))
dad
##   historico cancer   f
## 1       sim    sim  17
## 2       sim    não  36
## 3       não    sim   8
## 4       não    não 102

tabela de contingência 2x2

tab <- xtabs(f ~ historico + cancer, data=dad)

addmargins(tab)
##          cancer
## historico não sim Sum
##       não 102   8 110
##       sim  36  17  53
##       Sum 138  25 163

acrescentando aos dados as proporções de acordo com o modelo para fazer os gráficos

dad <- dad %>% group_by(cancer) %>% mutate(p = f/sum(f)) %>%
   ungroup()
dad
## # A tibble: 4 × 4
##   historico cancer     f     p
##   <chr>     <chr>  <dbl> <dbl>
## 1 sim       sim       17 0.68 
## 2 sim       não       36 0.261
## 3 não       sim        8 0.32 
## 4 não       não      102 0.739

Gráficos de colunas múltiplas e segmentadas

ggplot(dad, aes(x = cancer, y = p, fill = historico)) +
   geom_col(position = "dodge") + ylim(c(0, 1)) +
   theme(legend.position = "top") +
   labs(x = "Exposição ao fator", y = "Proporções amostrais",
        fill = "", title = "Gráfico de colunas múltiplas") +
   geom_text(aes(label = round(p, 3)), vjust = 1.5,
             position = position_dodge(.9))

Gráfico de colunas segmentadas

ggplot(dad, aes(x = cancer, y = p, fill = historico)) +
   geom_col() + ylim(c(0, 1)) +
   theme(legend.position = "top") +
   labs(x = "Exposição ao fator", y = "Proporções amostrais",
        fill = "", title = "Gráfico de colunas segmentadas") +
   geom_text(aes(label = round(p, 3)),
             position = position_stack(vjust = .8))

Gráficos de barras múltiplas e segmentadas

ggplot(dad, aes(x = cancer, y = p, fill = historico)) +
   geom_col(position = "dodge") + ylim(c(0, 1)) +
   theme(legend.position = "top") +
   labs(x = "Tratamentos", y = "Proporções amostrais",
        fill = "", title = "Gráfico de barras múltiplas") +
   geom_text(aes(label = round(p, 3)), hjust = 1.5,
             position = position_dodge(.9)) +
   coord_flip()

Gráfico de barras segmentadas

ggplot(dad, aes(x = cancer, y = p, fill = historico)) +
   geom_col() + ylim(c(0, 1)) +
   theme(legend.position = "top") +
   labs(x = "Grupos", y = "Proporções amostrais",
        fill = "", title = "Gráfico de barras segmentadas") +
   geom_text(aes(label = round(p, 3)), hjust = 1.2,
             position = position_stack()) +
   coord_flip()

ex 5 - dados da tabela

dad <- data.frame(trat = rep(c("I", "II", "III"), each = 2),
                  obito = rep(c("sim", "não"), 3),
                  f = c(42, 203-42, 22, 203-22, 29, 205-29))
dad
##   trat obito   f
## 1    I   sim  42
## 2    I   não 161
## 3   II   sim  22
## 4   II   não 181
## 5  III   sim  29
## 6  III   não 176

tabela de contingência 3x2

tab <- xtabs(f ~ trat + obito, data=dad)

addmargins(tab)
##      obito
## trat  não sim Sum
##   I   161  42 203
##   II  181  22 203
##   III 176  29 205
##   Sum 518  93 611

acrescentando aos dados as proporções de acordo com o modelo para fazer os gráficos

dad <- dad %>% group_by(trat) %>% mutate(p = f/sum(f)) %>%
   ungroup()
dad
## # A tibble: 6 × 4
##   trat  obito     f     p
##   <chr> <chr> <dbl> <dbl>
## 1 I     sim      42 0.207
## 2 I     não     161 0.793
## 3 II    sim      22 0.108
## 4 II    não     181 0.892
## 5 III   sim      29 0.141
## 6 III   não     176 0.859

Gráficos de colunas múltiplas

ggplot(dad, aes(x = trat, y = p, fill = obito)) +
   geom_col(position = "dodge") + ylim(c(0, 1)) +
   theme(legend.position = "top") +
   labs(x = "Exposição ao fator", y = "Proporções amostrais",
        fill = "", title = "Gráfico de colunas múltiplas") +
   geom_text(aes(label = round(p, 3)), vjust = 1.2,
             position = position_dodge(.9))

Gráfico de colunas segmentadas

ggplot(dad, aes(x = trat, y = p, fill = obito)) +
   geom_col() + ylim(c(0, 1)) +
   theme(legend.position = "top") +
   labs(x = "Exposição ao fator", y = "Proporções amostrais",
        fill = "", title = "Gráfico de colunas segmentadas") +
   geom_text(aes(label = round(p, 3)),
             position = position_stack(vjust=.6))

Gráfico de barras múltiplas

#gráficos de barras múltiplas e segmentadas
ggplot(dad, aes(x = trat, y = p, fill = obito)) +
   geom_col(position = "dodge") + ylim(c(0, 1)) +
   theme(legend.position = "top") +
   labs(x = "Tratamentos", y = "Proporções amostrais",
        fill = "", title = "Gráfico de barras múltiplas") +
   geom_text(aes(label = round(p, 3)), hjust = 1.5,
             position = position_dodge(.9)) +
   coord_flip()

Gráfico de barras segmentadas

ggplot(dad, aes(x = trat, y = p, fill = obito)) +
   geom_col() + ylim(c(0, 1)) +
   theme(legend.position = "top") +
   labs(x = "Grupos", y = "Proporções amostrais",
        fill = "", title = "Gráfico de barras segmentadas") +
   geom_text(aes(label = round(p, 3)), hjust = 1.2,
             position = position_stack()) +
   coord_flip()

exercício extra

## planilha adaptada de https://www.gov.br/inep/pt-br/acesso-a-informacao/dados-abertos/indicadores-educacionais/indicadores-de-qualidade-da-educacao-superior
library(readxl)
url <- paste0("https://download.inep.gov.br/educacao_superior/indicadores/",
              "resultados/2019/resultados_cpc_2019.xlsx")
destfile <- "resultados_cpc_2019.xlsx"
curl::curl_download(url, destfile)
dados <- read_excel(destfile)

dados$Nota_doutor <- dados$`Nota Padronizada - Doutores`
dados$Conceito_Enade_faixa <- dados$`Conceito Enade (Contínuo)`

dados$doutor <- ifelse(dados$Nota_doutor < 2, 'inferior',
                       ifelse(dados$Nota_doutor >= 2 &
                                dados$Nota_doutor <= 3, 'médio',
                              'superior'))
dados$Enade <- ifelse(dados$Conceito_Enade_faixa < 2, 'inferior',
                      ifelse(dados$Conceito_Enade_faixa >= 2 &
                               dados$Conceito_Enade_faixa <= 3, 'médio',
                             'superior'))

tabela de contingencia 3x3

tab <- xtabs(~ doutor + Enade, data=dados)
addmargins(tab)
##           Enade
## doutor     inferior médio superior  Sum
##   inferior     1299   983      328 2610
##   médio        1043  1033      469 2545
##   superior      743  1048     1243 3034
##   Sum          3085  3064     2040 8189