Pacotes

##Limpar Memoria
rm(list=ls())

## Instalar Pacotes
#install.packages("devtools")
#install.packages("tidyverse")
#install.packages("DT")
#devtools::install_github("renkun-ken/formattable")

## Carregar Pacotes
library(devtools)
require(tidyverse)
require(DT)
require(formattable)

Dados

#Importacao dos dados
dadosteste <- read.csv("C:/Users/USER/OneDrive/Estuda/dados_teste.csv")

glimpse(dadosteste)
## Rows: 2,000
## Columns: 19
## $ X               <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, ...
## $ NU_IDADE        <int> 15, 23, 32, 19, 29, 20, 19, 20, 47, 25, 21, 22, 30,...
## $ TP_SEXO         <chr> "M", "M", "F", "F", "F", "M", "M", "F", "F", "M", "...
## $ TP_ESCOLA       <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 4, ...
## $ TP_ENSINO       <int> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,...
## $ SG_UF_PROVA     <chr> "PE", "SP", "MG", "MA", "PR", "MS", "MG", "PR", "RN...
## $ NU_NOTA_CN      <dbl> 527.4, 558.9, 496.0, 412.4, 546.8, 515.0, 581.5, 55...
## $ NU_NOTA_CH      <dbl> 545.7, 590.0, 552.2, 544.0, 584.1, 566.8, 490.8, 58...
## $ NU_NOTA_LC      <dbl> 561.5, 575.3, 511.0, 496.6, 576.5, 505.6, 479.4, 58...
## $ NU_NOTA_MT      <dbl> 500.6, 587.8, 597.9, 372.3, 412.2, 586.5, 518.2, 55...
## $ TX_RESPOSTAS_CN <chr> "BEAEAADABBAAADBBABAECABCCCBEBADACDBACAEABEBAB", "A...
## $ TX_RESPOSTAS_CH <chr> "BBADDAAEEDCABEDAACAADDABEEEEDADDAEABBABDCDEED", "B...
## $ TX_RESPOSTAS_LC <chr> "CCBDE99999BDAECAABCECEABECDEAADBBACEADBACAAAAADDBA...
## $ TX_RESPOSTAS_MT <chr> "BCCCABAEBBDADDAEDAABABAAACCAABDDABEAEBDCAAEAA", "A...
## $ TP_LINGUA       <int> 0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 1, 1, 0, 1, 1, 0, 0, ...
## $ TX_GABARITO_CN  <chr> "DEEBDABCBBEDDCBABCADECEBAADAAECDCBCCDACDEEAAE", "D...
## $ TX_GABARITO_CH  <chr> "CDDECADBEABDBEDAECAEBDAEBAEDBDBBAECDAEBCCCCDE", "C...
## $ TX_GABARITO_LC  <chr> "DDCDEEDBEEBDAEDAABCECDAEBADEDEDBBBDEABBCCABAAEDDCB...
## $ TX_GABARITO_MT  <chr> "ADBCCECBBDBAEBBDDDABDCCDEDECBEACDAEAABBACEECD", "A...

Tabelas

Tabela 1: Média e desvio padrão das notas de Ciências Humanas, Ciências da Natureza, Literatura e Matemática

resumo1 = dadosteste %>%
  select(X,NU_NOTA_CH, NU_NOTA_CN, NU_NOTA_LC, NU_NOTA_MT)

  names(resumo1) = c("Id","Ciencias Humanas", "Ciencias da Natureza", 
                    "Linguagens e Códigos", "Matematica")
 
resumo1 = resumo1 %>%
  pivot_longer(!Id, names_to = "Area", values_to = "Nota") %>%
  group_by(Area) %>%
  summarise(Média = round(mean(Nota),2), 'Desvio Padrão' = round(sd(Nota),2))

datatable(resumo1, options = list(dom = 't'), filter = "none")

Tabela 2: Número e porcentagem de estudantes com idade maior que 17 e menor que 23

resumo2 = dadosteste %>%
    mutate(Idade = ifelse(NU_IDADE < 23 & NU_IDADE > 17,
                          "Maior que 17 e menor 23", "Caso Contrario")) %>%
    group_by(Idade) %>%
    summarise('Número'= n(),'Porcentagem'= paste0(n()/nrow(dadosteste)*100,
                                                   '%')) %>%
    arrange(desc(Idade))

resumo2 = dadosteste %>%
  mutate(Idade = ifelse(NU_IDADE < 23 & NU_IDADE > 17,
                        "Maior que 17 e menor 23", "Caso Contrario")) %>%
  group_by(Idade) %>%
  summarise(Número = n(), Porcentagem = paste0(n()/nrow(dadosteste)*100,'%')) %>%
  arrange(desc(Idade))

datatable(resumo2, options = list(dom = 't'), filter = "none" )

Tabela 3: Número e porcentagem de estudantes por Estado

resumo3 = dadosteste %>%
  select(Estado = SG_UF_PROVA) %>%
  group_by(Estado) %>%
  summarise(Numero = n(), Porcentagem = paste0(n()/nrow(dadosteste)*100,"%")) %>%
  arrange(desc(Numero))

datatable(resumo3, filter = "none" )

Tabela 4: Idade média, mínima e máxima por tipo de escola

resumo4 = dadosteste %>%
  select(NU_IDADE, TP_ESCOLA) %>%
  mutate(Tipo_Escola = factor(TP_ESCOLA,
                       levels = c(1,2,3,4),
                       labels = c("Não Respondeu", "Publica", "Privada", 
                                    "Exterior"))) %>%
  group_by(Tipo_Escola) %>%
  summarise(Média = round(mean(NU_IDADE),2), Minimo = min(NU_IDADE),
            Maximo = max(NU_IDADE))

datatable(resumo4, options = list(dom = 't'), filter = "none" )

Tabela 5: Tabela com média e desvio padrão da nota de Literatura divididos em Inglês e Espanhol

resumo5 = dadosteste %>%
  mutate(TP_LINGUA = ifelse(TP_LINGUA == 0,'Inglês','Espanhol')) %>%
  group_by(Lingua = TP_LINGUA) %>%
  summarise(Média = round(mean(NU_NOTA_LC),2), 
            'Desvio Padrão' = round(sd(NU_NOTA_LC),2))

datatable(resumo5, options = list(dom = 't'), filter = "none" )

Tabela 6: Número, porcentagem e média da nota de Matemática dos alunos com idade dividido em dois grupos, menores ou com 21 anos de idade e maiores de 21 anos de idade e Região (Centro-Oeste, Sudeste, Sul, Norte, Nordeste)

dados = dadosteste
names(dados)[grep('SG_UF_PROVA', names(dados))] <- 'UF'

dados$Regiao[dados$UF %in% c('RO', 'AC', 'AM', 'RR', 'PA', 'AP', 'TO')] <- 'Norte' 
dados$Regiao[dados$UF %in% c('MA', 'PI', 'CE', 'RN', 'PB', 'PE', 'AL', 'SE', 'BA')] <- 'Nordeste' 
dados$Regiao[dados$UF %in% c('MG', 'ES', 'RJ', 'SP')] <- 'Sudeste'   
dados$Regiao[dados$UF %in% c('PR', 'SC', 'RS')] <- 'Sul'
dados$Regiao[dados$UF %in% c('MS', 'MT', 'GO', 'DF')] <- 'Centro Oeste'

resumo6 = dados %>%
  mutate(NU_IDADE = ifelse(NU_IDADE <= 21, "21 anos ou menos", "Mais de 21 anos")) %>%
  group_by(Idade = NU_IDADE, Regiao) %>% 
  summarise(N = n(), Porcentagem = paste0(n()/nrow(dados)*100,'%'),
            Média = round(mean(NU_NOTA_MT),2))

datatable(resumo6, options = list(dom = 't'), filter = "none" )

Grafico Boxplot Nota de Matemática por Idade e Região

Idade1: Menor de 21 anos Idade2: Maior de 21 anos

dados1 <- dados %>%
    mutate(Idade = ifelse(NU_IDADE <= 21, 'Idade1' , 'Idade2'),
         Nota_Matematica = NU_NOTA_MT) %>%
    select(Regiao, Idade, Nota_Matematica) 

ggplot(dados1, aes(x = Regiao, y = Nota_Matematica, fill = Regiao)) +
  geom_boxplot() +
  scale_fill_brewer(palette = "Accent") +
  theme_gray() +
  facet_wrap(vars(Idade)) 

Tabela 7: Taxa de Acerto por Questão e Área

#############
### Calculo da Taxa de acertos por questão e Area 

#Ciencias da Natureza

RESPOSTAS_CN = data.frame(1:45)
for (i in 1:2000) {
  RESPOSTAS_CN[i] = strsplit(dadosteste$TX_RESPOSTAS_CN[i], "")
} 
names(RESPOSTAS_CN)[1] <- 'V1'

GABARITO_CN = unlist(strsplit(dadosteste$TX_GABARITO_CN[1], ""))
 
MT_RESPOSTA_CN = matrix(rep(0), nrow = 45, ncol = 2000)

for(j in 1:45){
for(i in 1:2000) {
  MT_RESPOSTA_CN[j,i] = ifelse(RESPOSTAS_CN[j,i] == GABARITO_CN[j],1,0)
  }
    }

taxaAcertoCN = percent(rowMeans(MT_RESPOSTA_CN))

#Ciencias Humanas

RESPOSTAS_CH = data.frame(1:45)
for (i in 1:2000) {
  RESPOSTAS_CH[i] = strsplit(dadosteste$TX_RESPOSTAS_CH[i], "")
}

GABARITO_CH = unlist(strsplit(dadosteste$TX_GABARITO_CH[1], ""))

MT_RESPOSTA_CH = matrix(rep(0), nrow = 45, ncol = 2000)
for(j in 1:45){
  for(i in 1:2000) {
    MT_RESPOSTA_CH[j,i] = ifelse(RESPOSTAS_CH[j,i] == GABARITO_CH[j],1,0)
  }
}

taxaAcertoCH = percent(rowMeans(MT_RESPOSTA_CH))

#Linguagens Codigos

RESPOSTAS_LC = data.frame(1:45)
for (i in 1:2000) {
  RESPOSTAS_LC[i] = strsplit(dadosteste$TX_RESPOSTAS_LC[i], "")
} 

GABARITO_LC = unlist(strsplit(dadosteste$TX_GABARITO_LC[1], ""))

MT_RESPOSTA_LC = matrix(rep(0), nrow = 45, ncol = 2000)

for(j in 1:45){
  for(i in 1:2000) {
    MT_RESPOSTA_LC[j,i] = ifelse(RESPOSTAS_LC[j,i] == GABARITO_LC[j],1,0)
  }
}

taxaAcertoLC = percent(rowMeans(MT_RESPOSTA_LC))

#Matematica

RESPOSTAS_MT = data.frame(1:45)
for (i in 1:2000) {
  RESPOSTAS_MT[i] = strsplit(dadosteste$TX_RESPOSTAS_MT[i], "")
}

GABARITO_MT = unlist(strsplit(dadosteste$TX_GABARITO_MT[1], ""))

MT_RESPOSTA_MT = matrix(rep(0), nrow = 45, ncol = 2000)

for(j in 1:45){
  for(i in 1:2000) {
    MT_RESPOSTA_MT[j,i] = ifelse(RESPOSTAS_MT[j,i] == GABARITO_MT[j],1,0)
  }
}

taxaAcertoMT = percent(rowMeans(MT_RESPOSTA_MT))

## Tabela Taxa de Acerto

taxaAcerto = tibble(1:45,taxaAcertoCH, taxaAcertoCN, 
                    taxaAcertoLC, taxaAcertoMT)
            
names(taxaAcerto) = c("Questão", "Ciências Humanas", "Ciências da Natureza", 
                      "Linguagens e Códigos", "Matemática")

formattable(taxaAcerto)
Questão Ciências Humanas Ciências da Natureza Linguagens e Códigos Matemática
1 35.85% 18.10% 30.90% 15.90%
2 64.30% 31.50% 28.60% 14.85%
3 24.25% 33.25% 16.20% 28.95%
4 58.70% 45.05% 32.95% 45.20%
5 57.00% 14.00% 27.15% 11.35%
6 67.55% 37.90% 18.85% 14.35%
7 45.10% 30.05% 26.00% 24.20%
8 23.45% 28.60% 25.45% 10.10%
9 41.05% 55.75% 15.30% 33.10%
10 52.40% 56.15% 18.95% 26.65%
11 51.45% 64.95% 75.70% 26.35%
12 26.20% 11.95% 47.25% 29.10%
13 69.40% 17.30% 47.25% 36.10%
14 39.25% 32.50% 61.10% 34.05%
15 51.65% 44.95% 33.95% 45.45%
16 58.10% 6.70% 74.60% 27.90%
17 38.35% 42.65% 27.75% 38.90%
18 32.50% 11.95% 26.15% 18.70%
19 36.55% 41.40% 54.10% 68.75%
20 45.30% 47.00% 54.05% 57.20%
21 23.80% 27.50% 45.15% 22.55%
22 48.20% 23.80% 59.80% 43.90%
23 17.90% 15.85% 33.90% 22.30%
24 31.55% 18.80% 72.90% 28.00%
25 23.20% 52.00% 20.90% 6.45%
26 52.40% 19.50% 72.90% 30.20%
27 51.35% 18.25% 48.55% 12.85%
28 34.65% 52.00% 67.15% 29.45%
29 45.90% 14.00% 40.35% 49.80%
30 18.50% 21.90% 17.90% 16.05%
31 45.70% 20.75% 43.80% 19.80%
32 37.25% 25.25% 80.10% 17.70%
33 58.55% 25.80% 63.80% 29.25%
34 26.95% 24.20% 17.80% 17.20%
35 41.05% 34.20% 39.90% 40.00%
36 26.25% 34.95% 62.10% 30.50%
37 27.15% 24.05% 56.75% 11.60%
38 24.65% 26.50% 15.55% 29.70%
39 53.90% 10.70% 87.00% 28.40%
40 26.30% 32.40% 30.75% 24.30%
41 54.00% 8.70% 25.25% 25.30%
42 42.80% 57.50% 61.75% 27.70%
43 37.90% 17.30% 40.30% 55.30%
44 16.55% 22.20% 18.35% 27.50%
45 12.45% 31.15% 54.45% 16.75%

Modelo de Regressão

Modelo para estimar a nota TRI de Ciências Humanas baseado no total de acertos.

Segue o modelo que melhor se ajusta:

x = colSums(MT_RESPOSTA_CH)
y = dadosteste$NU_NOTA_CH

m2 = lm(y ~ x + I(x^2) + I(x^3)); m2 #Modelo Polinomial de grau 3
## 
## Call:
## lm(formula = y ~ x + I(x^2) + I(x^3))
## 
## Coefficients:
## (Intercept)            x       I(x^2)       I(x^3)  
##  250.771661    27.394406    -0.709199     0.008651
plot(x, y, ylab = "Nota de Ciencias Humanas", xlab = "Total de Acertos",
     main = "Gráfico de dispersão") 
curve(coef(m2)[1]+coef(m2)[2]*x+coef(m2)[3]*x^2+coef(m2)[4]*x^3,add=TRUE,
      col = "blue",lwd=2)

summary(m2)
## 
## Call:
## lm(formula = y ~ x + I(x^2) + I(x^3))
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -103.416  -11.419    1.568   13.115   77.044 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  2.508e+02  5.637e+00   44.48   <2e-16 ***
## x            2.739e+01  9.609e-01   28.51   <2e-16 ***
## I(x^2)      -7.092e-01  5.028e-02  -14.11   <2e-16 ***
## I(x^3)       8.651e-03  8.135e-04   10.63   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 21.36 on 1996 degrees of freedom
## Multiple R-squared:  0.927,  Adjusted R-squared:  0.9269 
## F-statistic:  8453 on 3 and 1996 DF,  p-value: < 2.2e-16

dado o p-valor os coeficientes são significativos.