Vinicius_relatorio_part2.R

library(knitr)

## Warning: pacote 'knitr' foi compilado no R versão 4.4.2

include_graphics("/Documents and Settings/Vinicius/Downloads/logo_uepb.png")

# Relatório estatístico referente a segunta etapa
# Aluno: Vinicius Henriques Brandão
# Disciplina: Visualização de Dados
# Professor: Oseas Machado

# 1

# faculdade (qualitativa nominal)
# sexo (qualitativa nominal)
# idade (quantitativa discreta)
# estado_civil (qualitativa nominal)
# filhos (quantitativa discreta)
# altura (quantitativa contínua)
# peso (quantitativa contínua)
# transporte (qualitativa nominal)
# exercício (quantitativa contínua)
# salario (quantitativa contínua)
# localidade (qualitativa nominal)

# 2

library(readr) # é utilizada para ler o arquivo falcudade.csv

## Warning: pacote 'readr' foi compilado no R versão 4.4.2

library(magrittr) # uso do %>%

## Warning: pacote 'magrittr' foi compilado no R versão 4.4.2

library(dplyr) # usada para agrupamentos e resumos, group_by() e summarise()

## Warning: pacote 'dplyr' foi compilado no R versão 4.4.2

## 
## Anexando pacote: 'dplyr'

## Os seguintes objetos são mascarados por 'package:stats':
## 
##     filter, lag

## Os seguintes objetos são mascarados por 'package:base':
## 
##     intersect, setdiff, setequal, union

library(formattable) # usada para aplicar cores nas tabelas

## Warning: pacote 'formattable' foi compilado no R versão 4.4.2

library(knitr) # é usada para criar documentos dinâmicos
library(ggplot2) # é usado Para criar gráficos 

## Warning: pacote 'ggplot2' foi compilado no R versão 4.4.2

Facul <- read.csv2("faculdade.csv")

grupoum <- Facul %>%
  group_by(faculdade) %>%
  summarise(alunos = n())

grupodois <- Facul %>%
  group_by(sexo) %>%
  summarise(alunos = n())

grupotres <- Facul %>%
  group_by(estado_civil) %>%
  summarise(alunos = n())

grupoquatro <- Facul %>%
  group_by(transporte) %>%
  summarise(alunos = n())

grupocinco <- Facul %>%
  group_by(localidade) %>%
  summarise(alunos = n())

# 3

gruposeis <- Facul %>%
  group_by(faculdade, sexo) %>%
  summarise(alunos = n())

## `summarise()` has grouped output by 'faculdade'. You can override using the
## `.groups` argument.

gruposete <- Facul %>%
  group_by(faculdade, estado_civil) %>%
  summarise(alunos = n())

## `summarise()` has grouped output by 'faculdade'. You can override using the
## `.groups` argument.

grupooito <- Facul %>%
  group_by(faculdade, transporte) %>%
  summarise(alunos = n())

## `summarise()` has grouped output by 'faculdade'. You can override using the
## `.groups` argument.

gruponove <- Facul %>%
  group_by(faculdade, localidade) %>%
  summarise(alunos = n())

## `summarise()` has grouped output by 'faculdade'. You can override using the
## `.groups` argument.

# 4

# Calcula o índice do 10º percentil, arredondando para o número inteiro mais próximo superior
percentdez <- ceiling((10 * (100 + 1)) / 100)

# Calcula o índice do 90º percentil, arredondando para o número inteiro mais próximo superior
percentnoventa <- ceiling((90 * (100 + 1)) / 100)

# Calcula o índice do 1º quartil, arredondando para o número inteiro mais próximo superior
quartum <- ceiling((100 + 1) / 4)

# Calcula o índice do 2º quartil, arredondando para o número inteiro mais próximo superior
quartdois <- ceiling((2 * (100 + 1)) / 4)

# Calcula o índice do 3º quartil, arredondando para o número inteiro mais próximo superior
quarttres <- ceiling((3 * (100 + 1)) / 4)

# Calcula a soma dos valores da variável 'altura' até o valor correspondente ao 3º quartil
quart3altu <- sum(Facul$altura[1:quarttres])

# Calcula a soma dos valores da variável 'altura' até o valor correspondente ao 1º quartil
quart1altu <- sum(Facul$altura[1:quartum])

# Calcula a soma dos valores da variável 'altura' até o valor correspondente ao percentil 90
percent90altu <- sum(Facul$altura[1:percentnoventa]) 

# Calcula a soma dos valores da variável 'altura' até o valor correspondente ao percentil 10
percent10altu <- sum(Facul$altura[1:percentdez])


TabelaAltura <- Facul %>%
  arrange(altura) %>%
  summarise(
    quartil1 = altura[quartum],              # 1º quartil
    quartil2 = altura[quartdois],            # 2º quartil (mediana)
    quartil3 = altura[quarttres],            # 3º quartil
    minima = min(altura),                    # Valor mínimo de altura
    media = mean(altura),                    # Média das alturas
    mediana = median(altura),                # Mediana das alturas
    maxima = max(altura),                    # Valor máximo de altura
    variancia = sum((altura - media)^2) / (n() - 1),  # Variância das alturas
    desvio_Padrao = sqrt(variancia),          # Desvio padrão das alturas
    coeficiente_variacao = (desvio_Padrao / media) * 100,  # Coeficiente de variação (%)
    coeficiente_Pearson = (3 * (media - mediana)) / desvio_Padrao,  # Coeficiente de Pearson
    curtose = (quart3altu - quart1altu) / (2 * (percent90altu - percent10altu))  # Curtose
  )

# Soma dos valores de peso até o 1º quartil
quart1peso <- sum(Facul$peso[1:quartum])

# Soma dos valores de peso até o 3º quartil
quart3peso <- sum(Facul$peso[1:quarttres])

# Soma dos valores de peso até o percentil 10
percent10peso <- sum(Facul$peso[1:percentdez]) 

# Soma dos valores de peso até o percentil 90
percent90peso <- sum(Facul$peso[1:percentnoventa])

TabelaPeso <- Facul %>%
  arrange(peso) %>%
  summarise(
    quartil1 = peso[quartum],                # 1º quartil
    quartil2 = peso[quartdois],              # 2º quartil (mediana)
    quartil3 = peso[quarttres],              # 3º quartil
    minimo = min(peso),                      # Valor mínimo de peso
    medio = mean(peso),                      # Média dos pesos
    mediano = median(peso),                  # Mediana dos pesos
    maximo = max(peso),                      # Valor máximo de peso
    variancia = sum((peso - medio)^2) / (n() - 1),  # Variância dos pesos
    desvio_Padrao = sqrt(variancia),         # Desvio padrão dos pesos
    coeficiente_variacao = (desvio_Padrao / medio) * 100,  # Coeficiente de variação (%)
    coeficiente_Pearson = (3 * (medio - mediano)) / desvio_Padrao,  # Coeficiente de Pearson
    curtose = (quart3peso - quart1peso) / (2 * (percent90peso - percent10peso))  # Curtose
  )

# Soma dos salários até o 1º quartil
quart1salario = sum(Facul$salario[1:quartum])

# Soma dos salários até o 3º quartil
quart3salario = sum(Facul$salario[1:quarttres])

# Soma dos salários até o percentil 10
percent10salario = sum(Facul$salario[1:percentdez])

# Soma dos salários até o percentil 90
percent90salario = sum(Facul$salario[1:percentnoventa])

TabelaSalario <- Facul %>%
  arrange(salario) %>%
  summarise(
    quartil1 = salario[quartum],                  # 1º quartil
    quartil2 = salario[quartdois],                 # 2º quartil (mediana)
    quartil3 = salario[quarttres],                # 3º quartil
    minimo = min(salario),                        # Valor mínimo de salário
    medio = mean(salario),                        # Média dos salários
    mediano = median(salario),                    # Mediana dos salários
    maximo = max(salario),                        # Valor máximo de salário
    variancia = sum((salario - medio)^2) / (n() - 1),  # Variância dos salários
    desvio_Padrao = sqrt(variancia),               # Desvio padrão dos salários
    coeficiente_variacao = (desvio_Padrao / medio) * 100,  # Coeficiente de variação (%)
    coeficiente_Pearson = (3 * (medio - mediano)) / desvio_Padrao,  # Coeficiente de Pearson
    curtose = (quart3salario - quart1salario) / (2 * (percent90salario - percent10salario))  # Curtose
  )

# 5

Facul$IMC <- Facul$peso / (Facul$altura^2)  # Cálculo do IMC (Índice de Massa Corporal)

pegamoda <- function(x) {
  z <- table(as.vector(round(x)))
  names(z) [z == max(z)]
}

DatasetIMC <- Facul %>%
  group_by(faculdade, sexo) %>%
  arrange(IMC) %>%
  summarise(
    alunos = n(),
    quartil3 = sum(Facul$IMC[1:quarttres]),            # Soma do IMC até o 3º quartil
    quartil1 = sum(Facul$IMC[1:quartum]),              # Soma do IMC até o 1º quartil
    percentil90 = sum(Facul$IMC[1:percentnoventa]),    # Soma do IMC até o percentil 90
    percentil10 = sum(Facul$IMC[1:percentdez]),        # Soma do IMC até o percentil 10
    moda = pegamoda(IMC)[1],                           # Moda do IMC
    medio = mean(IMC),                                 # Média do IMC
    mediano = median(IMC),                             # Mediana do IMC
    variancia = sum((IMC - medio)^2) / (n() - 1),      # Variância do IMC
    desvio_Padrao = sqrt(variancia),                   # Desvio padrão do IMC
    coefi_Pearson = (3 * (medio - mediano)) / desvio_Padrao,  # Coeficiente de Pearson
    curtose = (quartil3 - quartil1) / (2 * (percentil90 - percentil10)),  # Curtose do IMC
    coeficiente_variacao = (desvio_Padrao / medio) * 100   # Coeficiente de variação
  )

## `summarise()` has grouped output by 'faculdade'. You can override using the
## `.groups` argument.

# 6

cores <- function(x) {
  scales::col_numeric(palette = c("lightblue", "darkblue", "gray"), domain = NULL)(x)
}

grupoum %>%
  formattable(list(
    alunos = formatter("span",
                       style = x ~ style(background = cores(x)))
  ))

faculdade	alunos
A	30
B	29
C	41

grupodois %>%
  formattable(list(
    alunos = formatter("span",
                       style = x ~ style(background = cores(x)))
  ))

sexo	alunos
F	43
M	57

grupotres %>%
  formattable(list(
    alunos = formatter("span",
                       style = x ~ style(background = cores(x)))
  ))

estado_civil	alunos
casado	31
divorciado	19
outro	29
solteiro	21

grupoquatro %>%
  formattable(list(
    alunos = formatter("span",
                       style = x ~ style(background = cores(x)))
  ))

transporte	alunos
bibicleta	31
moto	24
onibus	18
outro	27

grupocinco %>%
  formattable(list(
    alunos = formatter("span",
                       style = x ~ style(background = cores(x)))
  ))

localidade	alunos
zona rural	58
zona urbana	42

gruposeis %>%
  formattable(list(
    alunos = formatter("span",
                       style = x ~ style(background = cores(x)))
  ))

faculdade	sexo	alunos
A	F	12
A	M	18
B	F	14
B	M	15
C	F	17
C	M	24

gruposete %>%
  formattable(list(
    alunos = formatter("span",
                       style = x ~ style(background = cores(x)))
  ))

faculdade	estado_civil	alunos
A	casado	11
A	divorciado	4
A	outro	7
A	solteiro	8
B	casado	10
B	divorciado	7
B	outro	7
B	solteiro	5
C	casado	10
C	divorciado	8
C	outro	15
C	solteiro	8

grupooito %>%
  formattable(list(
    alunos = formatter("span",
                       style = x ~ style(background = cores(x)))
  ))

faculdade	transporte	alunos
A	bibicleta	10
A	moto	7
A	onibus	6
A	outro	7
B	bibicleta	8
B	moto	7
B	onibus	8
B	outro	6
C	bibicleta	13
C	moto	10
C	onibus	4
C	outro	14

gruponove %>%
  formattable(list(
    alunos = formatter("span",
                       style = x ~ style(background = cores(x)))
  ))

faculdade	localidade	alunos
A	zona rural	17
A	zona urbana	13
B	zona rural	20
B	zona urbana	9
C	zona rural	21
C	zona urbana	20

ggplot(Facul, aes(x = estado_civil, fill = estado_civil)) +
  geom_bar() +
  facet_wrap(~ faculdade) +
  labs(title = "Distribuição de Estado Civil por Faculdade",
       x = "Estado Civil",
       y = "Frequência") +
  theme_minimal()

ggplot(Facul, aes(x = sexo, fill = sexo)) +
  geom_bar() +
  facet_wrap(~ faculdade) +
  labs(title = "Distribuição de Sexo por Faculdade",
       x = "Sexo",
       y = "Frequência") +
  theme_minimal()

ggplot(Facul, aes(x = filhos, fill = filhos)) +
  geom_bar() +
  facet_wrap(~ faculdade) +
  labs(title = "Distribuição de Filhos por Faculdade",
       x = "Número de Filhos",
       y = "Frequência") +
  theme_minimal()

## Warning: The following aesthetics were dropped during statistical transformation: fill.
## ℹ This can happen when ggplot fails to infer the correct grouping structure in
##   the data.
## ℹ Did you forget to specify a `group` aesthetic or to convert a numerical
##   variable into a factor?

## Warning: The following aesthetics were dropped during statistical transformation: fill.
## ℹ This can happen when ggplot fails to infer the correct grouping structure in
##   the data.
## ℹ Did you forget to specify a `group` aesthetic or to convert a numerical
##   variable into a factor?
## The following aesthetics were dropped during statistical transformation: fill.
## ℹ This can happen when ggplot fails to infer the correct grouping structure in
##   the data.
## ℹ Did you forget to specify a `group` aesthetic or to convert a numerical
##   variable into a factor?

ggplot(Facul, aes(x = transporte, fill = transporte)) +
  geom_bar() +
  facet_wrap(~ faculdade) +
  labs(title = "Distribuição de Transporte por Faculdade",
       x = "Tipo de Transporte",
       y = "Frequência") +
  theme_minimal()

ggplot(Facul, aes(x = localidade, fill = localidade)) +
  geom_bar() +
  facet_wrap(~ faculdade) +
  labs(title = "Distribuição de Localidade por Faculdade",
       x = "Localidade",
       y = "Frequência") +
  theme_minimal()

ggplot(Facul, aes(x = idade, fill = faculdade)) +
  geom_histogram(bins = 30, alpha = 0.7, position = "identity") +
  facet_wrap(~ faculdade) +
  labs(title = "Distribuição de Idade por Faculdade",
       x = "Idade",
       y = "Frequência") +
  theme_minimal()

ggplot(Facul, aes(x = altura, fill = faculdade)) +
  geom_histogram(bins = 30, alpha = 0.7, position = "identity") +
  facet_wrap(~ faculdade) +
  labs(title = "Distribuição de Altura por Faculdade",
       x = "Altura",
       y = "Frequência") +
  theme_minimal()

ggplot(Facul, aes(x = peso, fill = faculdade)) +
  geom_histogram(bins = 30, alpha = 0.7, position = "identity") +
  facet_wrap(~ faculdade) +
  labs(title = "Distribuição de Peso por Faculdade",
       x = "Peso",
       y = "Frequência") +
  theme_minimal()

ggplot(Facul, aes(x = exercicio, fill = faculdade)) +
  geom_histogram(bins = 30, alpha = 0.7, position = "identity") +
  facet_wrap(~ faculdade) +
  labs(title = "Distribuição de Exercício por Faculdade",
       x = "Horas de Exercício por Semana",
       y = "Frequência") +
  theme_minimal()

ggplot(Facul, aes(x = salario, fill = faculdade)) +
  geom_histogram(bins = 30, alpha = 0.7, position = "identity") +
  facet_wrap(~ faculdade) +
  labs(title = "Distribuição de Salário por Faculdade",
       x = "Salário",
       y = "Frequência") +
  theme_minimal()

# Criar resumo estatístico
resumo <- Facul %>%
  group_by(faculdade) %>%
  summarise(
    Idade_Média = mean(idade, na.rm = TRUE),
    Altura_Média = mean(altura, na.rm = TRUE),
    Peso_Médio = mean(peso, na.rm = TRUE),
    Exercício_Médio = mean(exercicio, na.rm = TRUE),
    Salário_Médio = mean(salario, na.rm = TRUE)
  )

# Exibir tabela formatada
formattable(resumo, list(
  Idade_Média = color_tile("white", "lightblue"),
  Altura_Média = color_tile("white", "lightgreen"),
  Peso_Médio = color_tile("white", "lightpink"),
  Exercício_Médio = color_tile("white", "lightyellow"),
  Salário_Médio = color_tile("white", "lightcoral")
))

faculdade	Idade_Média	Altura_Média	Peso_Médio	Exercício_Médio	Salário_Médio
A	27.00000	1.663336	71.60000	4.700000	2.80000
B	27.10345	1.667685	63.86207	4.620690	2.62069
C	27.21951	1.687319	69.87805	4.878049	3.04878

ggplot(Facul, aes(x = idade, y = peso, color = sexo)) +
  geom_point(alpha = 0.7, size = 3) +
  facet_wrap(~ faculdade) +
  labs(title = "Peso x Idade por Sexo e Faculdade",
       x = "Idade",
       y = "Peso",
       color = "Sexo") +
  theme_minimal()

ggplot(Facul, aes(x = altura, y = peso, color = sexo)) +
  geom_point(alpha = 0.7, size = 3) +
  facet_wrap(~ faculdade) +
  labs(title = "Peso x Altura por Sexo e Faculdade",
       x = "Altura",
       y = "Peso",
       color = "Sexo") +
  theme_minimal()

ggplot(Facul, aes(x = exercicio, y = peso, color = sexo)) +
  geom_point(alpha = 0.7, size = 3) +
  facet_wrap(~ faculdade) +
  labs(title = "Peso x Exercício por Sexo e Faculdade",
       x = "Horas de Exercício por Semana",
       y = "Peso",
       color = "Sexo") +
  theme_minimal()

# Criar tabela de resumo
resumo <- Facul %>%
  group_by(faculdade, sexo) %>%
  summarise(
    Peso_Médio = mean(peso, na.rm = TRUE),
    Idade_Média = mean(idade, na.rm = TRUE),
    Altura_Média = mean(altura, na.rm = TRUE),
    Exercício_Médio = mean(exercicio, na.rm = TRUE)
  )

## `summarise()` has grouped output by 'faculdade'. You can override using the
## `.groups` argument.

# Formatar a tabela
formattable(resumo, list(
  Peso_Médio = color_tile("white", "lightblue"),
  Idade_Média = color_tile("white", "lightgreen"),
  Altura_Média = color_tile("white", "lightpink"),
  Exercício_Médio = color_tile("white", "lightyellow")
))

faculdade	sexo	Peso_Médio	Idade_Média	Altura_Média	Exercício_Médio
A	F	68.83333	26.66667	1.701898	4.083333
A	M	73.44444	27.22222	1.637628	5.111111
B	F	67.42857	27.35714	1.691645	4.285714
B	M	60.53333	26.86667	1.645322	4.933333
C	F	69.52941	27.88235	1.669783	3.764706
C	M	70.12500	26.75000	1.699741	5.666667

# Conversão de variáveis numéricas
Facul <- Facul %>%
  mutate(
    idade = as.numeric(idade),
    peso = as.numeric(peso),
    salario = as.numeric(salario),
    exercicio = as.numeric(exercicio)
  )

# Função para criar os boxplots
criar_boxplot <- function(variavel, titulo) {
  ggplot(Facul, aes(x = sexo, y = .data[[variavel]], fill = sexo)) +
    geom_boxplot() +
    facet_wrap(~ faculdade) +
    labs(title = titulo, x = "Sexo", y = variavel) +
    theme_minimal()
}

# Boxplots para cada variável
boxplot_idade <- criar_boxplot("idade", "Boxplot da Idade por Sexo e Faculdade")
boxplot_peso <- criar_boxplot("peso", "Boxplot do Peso por Sexo e Faculdade")
boxplot_salario <- criar_boxplot("salario", "Boxplot do Salário por Sexo e Faculdade")
boxplot_exercicio <- criar_boxplot("exercicio", "Boxplot do Exercício por Sexo e Faculdade")

# Exibir os gráficos
boxplot_idade

boxplot_peso

boxplot_salario

boxplot_exercicio