##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)
#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...
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")
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" )
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" )
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" )
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" )
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))
#############
### 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 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.