Para ampliar o dashboard, clique aqui.
Com objetivo de combater a retenção e a evasão verificada nos primeiros semestres dos cursos de exatas e engenharias, a universidade oferece uma disciplina preparatória para o Cálculo I, denominada Pré-Cálculo. Verificamos a eficiência relativa em termos de média final em Cálculo I e aprovação entre 3 campi da Ufersa. O campus Pau dos Ferros apresentou um tamanho de amostra muito pequeno.
Os dados apresentam Matrícula, Discente, IRA, IEA, Ano, Período, Código, Disciplina, Média, Número de Faltas, Status da Matrícula, Curso, Turno e Campus. A variável " Status da Matrícula" refere-se ao resultado do aluno em uma dada disciplina, podendo ser um valor dentro do conjunto {APROVADO, CANCELADO, CUMPRIU, DESISTENCIA, DISPENSADO, EXCLUÍDA, INDEFERIDO, MATRICULADO, REPROVADO, REPROVADO POR FALTAS, REPROVADO POR MÉDIA E POR FALTAS, TRANCADO}.
O objetivo inicial é analisar o desempenho dos alunos que cursaram o Pré-Cálculo na disciplina de Cálculo I em sua primeira tentativa de ser aprovado. Em um primeiro momento, as comparações serão feitas entre os campi. Para comparar a efetividade do Pré-Cálculo, precisamos dos mesmos dados para alunos que não cursaram a disciplina preparatória.
Dos dados originais, a variável DISCIPLINA foi filtrada para obter apenas os resultados em Cálculo I. Os alunos com Status da disciplina como MATRICULADO foram excluídos, pois ainda não há informação sobre o seu desempenho final (média e status final). No total, temos 246 matrículas dentro deste contexto.
A Tabela abaixo apresenta medidas sobre a média final em Cálculo I dos alunos neste recorte:
library(readxl)
library(tidyverse)
library(dplyr)
library(ggpubr)
library(gplots)
library(graphics)
library(corrplot)
library(ggplot2)
library(caret)
library(tibble)
library(rcompanion)
pre_calculus <- read_excel("G:/Drives compartilhados/ESTATISTICA/pre_calculo_estudo/data/pre_calculus.xlsx")
# Select columns of interest ----------------------------------------------
# filter only students enrolled in calculus I
pre_calculus %>% dplyr::select(DISCENTE, MATRÍCULA, ANO, PERÍODO,
DISCIPLINA, `STATUS DA MATRÍCULA`, MÉDIA, CURSO, CAMPUS, `NR. FALTAS`, TURNO) %>%
filter(DISCIPLINA %in% c("CALCULO I", "CÁLCULO I",
"CALCULO I (1200003)", "CÁLCULO I (1200003)") & (`STATUS DA MATRÍCULA` != "MATRICULADO")) -> pre_calc
# get the first attempt to be approved in calculus I ----------------------
pre_calc %>% group_by(MATRÍCULA) %>% filter(ANO == min(ANO) & PERÍODO == min(PERÍODO)) -> pre_calc
# Summary data on grades -----------------------------------------------
pre_calc$MÉDIA %>% summary %>% round(2) %>% unclass %>% data.frame(check.names = FALSE, stringsAsFactors = FALSE) %>% t -> sumario
#colnames(sumario) <- c("Medida", "Médias em Cálculo I")
colnames(sumario) <- c("Mínimo", "1º Qt", "Mediana", "Média", "3º Qt", "Máximo", "Vazios")
sumario %>% ggtexttable(rows=NULL, theme = ttheme("mBlue")) -> q
q + theme_void() + labs(title="Medidas das médias dos estudantes que pagaram Pré-Cálculo",
caption="Universidade Federal Rural do Semi-Árido - PROGRAD")Abaixo, ainda neste recorte, temos a situação dos estudantes (i) por Status, (ii) por curso de origem e o (iii) cruzamento de campus e Status. Finalmente, é apresentada a média na primeira tentativa de ser aprovado em Cálculo I e o total de alunos por campus. Nota-se que no campus Pau dos Ferros há apenas 2 alunos nesta situação. Além disso, os dados mostram que no campus de Angicos, os alunos apresentaram a melhor média. Será executado um teste de hipóteses para saber se há diferença estatisticamente significativa entre os desempenhos dos alunos para os campi Angicos, Caraúbas e Mossoró.
# summary data about performance ------------------------------------------
pre_calc$`STATUS DA MATRÍCULA` %>% table() %>% unclass %>% data.frame(check.names = FALSE, stringsAsFactors = FALSE) %>%
rownames_to_column() -> status_table
colnames(status_table) <- c("Status","Total")
status_table %>% ggtexttable(rows=NULL, theme = ttheme("mBlue")) -> q
q + theme_void() + labs(title="Situação dos estudantes em Cálculo I (primeira tentativa)",
caption="Universidade Federal Rural do Semi-Árido - PROGRAD")# de quais cursos estes alunos sao:
pre_calc$CURSO %>% table() %>% unclass %>% data.frame(check.names = FALSE, stringsAsFactors = FALSE) %>%
rownames_to_column() -> status_table
colnames(status_table) <- c("Curso","Total")
status_table %>% ggtexttable(rows=NULL, theme = ttheme("mBlue")) -> q
q + theme_void() + labs(title="Cursos dos estudantes em Cálculo I (primeira tentativa)",
caption="Universidade Federal Rural do Semi-Árido - PROGRAD")# de que campus:
pre_calc$CAMPUS %>% table() %>% unclass %>% data.frame(check.names = FALSE, stringsAsFactors = FALSE) %>%
rownames_to_column() -> status_table
colnames(status_table) <- c("Campus","Total")
status_table %>% ggtexttable(rows=NULL, theme = ttheme("mBlue")) -> q
#q + theme_void() + labs(title="Campus dos estudantes em Cálculo I (primeira tentativa)",
# caption="Universidade Federal Rural do Semi-Árido - PROGRAD")
# situacao por campi e status
# por campus e status
table(pre_calc$CAMPUS, pre_calc$`STATUS DA MATRÍCULA`) %>% unclass %>% data.frame(check.names = FALSE, stringsAsFactors = FALSE) %>%
t -> status_table
colnames(status_table) <- c("Angicos", "Caraúbas", "Mossoró", "Pau dos Ferros")
status_table %>% ggtexttable(theme = ttheme("mBlue")) -> q
q + theme_void() + labs(title="Estudantes em Cálculo I (primeira tentativa) por Campus e Status",
caption="Universidade Federal Rural do Semi-Árido - PROGRAD")# media por campus
pre_calc %>% group_by(CAMPUS) %>% dplyr::summarize(., media=round(mean(MÉDIA, na.rm=TRUE), 2), n=n()) %>% unclass %>%
data.frame(check.names = FALSE, stringsAsFactors = FALSE) -> status_table
colnames(status_table) <- c("Campus","Média", "Alunos")
status_table %>% ggtexttable(rows=NULL, theme = ttheme("mBlue")) -> q
q + theme_void() + labs(title="Médias em Cálculo I (primeira tentativa) por Campus",
caption="Universidade Federal Rural do Semi-Árido - PROGRAD")#
pre_calc %>% filter(., CAMPUS == "MOSSORÓ") -> mossoro
pre_calc %>% filter(., CAMPUS == "ANGICOS") -> angicos
pre_calc %>% filter(., CAMPUS == "CARAÚBAS") -> caraubasAbaixo, são apresentadas a contagem (removendo os NA’s da média), a média, desvio, mediana e a amplitude interquartil das médias finais em Cálculo I na primeira tentativa dos alunos que cursaram o Pré-Cálculo.
# Teste para comparacao das medias obtidas por campus ---------------------
# neste caso, estamos somente testando onde o pre-calculo fez mais efeito: kruskal-wallis + posthoc
data.frame(media = pre_calc$MÉDIA, group = pre_calc$CAMPUS) -> dados_kruskal
dados_kruskal[complete.cases(dados_kruskal), ] %>% filter(group != "PAU DOS FERROS") -> dados_kruskal
group_by(dados_kruskal, group) %>%
dplyr::summarize(
contagem = n(),
mean = mean(media, na.rm = TRUE) %>% round(2),
desvio = sd(media, na.rm = TRUE) %>% round(2),
mediana = median(media, na.rm = TRUE),
IQR = IQR(media, na.rm = TRUE)
) %>% unclass %>%
data.frame(check.names = FALSE, stringsAsFactors = FALSE) -> status_table
colnames(status_table) <- c("Campus","Contagem", "Média", "Desvio", "Mediana","AI")
status_table %>% ggtexttable(rows=NULL, theme = ttheme("mBlue")) -> q
q + theme_void() + labs(title="Médias em Cálculo I (primeira tentativa) por Campus",
caption="Universidade Federal Rural do Semi-Árido - PROGRAD")ggboxplot(dados_kruskal, x = "group", y = "media", fill="group", alpha=0.4,
ylab = "Medias", xlab = "Campus")ggline(dados_kruskal, x = "group", y = "media",
add = c("mean_se", "jitter"),
order = c("MOSSORÓ", "CARAÚBAS", "ANGICOS"),
ylab = "Médias", xlab = "Campus")Estamos interessados na comparação entre as 3 populações estudadas, a saber, os estudantes dos campi de Mossoró, Caraúbas e Angicos que cursaram o pré-cálculo. Testaremos a hipótese de que estas populações possuem a mesma distribuição. Para tanto, utilizaremos o teste não-paramétrico de Kruskal-Wallis. O valor-p fornecido pelo teste mostra pouca evidência a favor da hipótese nula, portanto, rejeitamos a hipótese de que os grupos são oriundos de uma mesma distribuição.
dados_kruskal$group <- as.factor(dados_kruskal$group)
tapply(dados_kruskal$media, dados_kruskal$group, median)## ANGICOS CARAÚBAS MOSSORÓ PAU DOS FERROS
## 700 480 560 NA
##
## Kruskal-Wallis rank sum test
##
## data: media by group
## Kruskal-Wallis chi-squared = 11.504, df = 2, p-value = 0.003176
Testando os pares de grupos, nota-se que há diferença significativa entre Caraúbas e Angicos:
##
## Pairwise comparisons using Wilcoxon rank sum test
##
## data: dados_kruskal$media and dados_kruskal$group
##
## ANGICOS CARAÚBAS
## CARAÚBAS 0.0037 -
## MOSSORÓ 0.2021 0.1592
##
## P value adjustment method: bonferroni
O teste de Kruskal-Wallis foi feito para comparar as médias dos estudantes que cursaram pré-cálculo em sua primeira tentativa de passar em Cálculo I em 3 campi da Ufersa. Foi verificada forte evidência de que há diferença entre os ranks médios em pelo menos um par de grupos
Realizamos o teste exato de Fisher, pois uma das frequências da tabela de contingência apresenta valor menor do que 5. Assim, rejeitamos a hipótese nula de que as proporções dos níveis da variável Campus são as mesmas para diferentes valores da variável Status (Aprovado ou não aprovado).
# 2. Graph
dt <- table(pre_calc$CAMPUS, pre_calc$`STATUS DA MATRÍCULA`)
balloonplot(dt, main ="Desempenho em Cálculo I", xlab ="", ylab="",
label = FALSE, show.margins = FALSE)## APROVADOS N_APROVADOS
## ANGICOS 25 4
## CARAÚBAS 56 65
## MOSSORÓ 54 40
## PAU DOS FERROS 0 2
##
## Fisher's Exact Test for Count Data with simulated p-value (based
## on 2000 replicates)
##
## data: dt[1:3, ]
## p-value = 0.0004998
## alternative hypothesis: two.sided
Realizando um teste pot-hoc, notamos que Angicos apresenta diferença significativa quando comparado com os outros campi da Ufersa:
PT = pairwiseNominalIndependence(dt[1:3,],
fisher = TRUE,
gtest = FALSE,
chisq = FALSE,
digits = 3)
PT## Comparison p.Fisher p.adj.Fisher
## 1 ANGICOS : CARAÚBAS 0.000122 0.000366
## 2 ANGICOS : MOSSORÓ 0.004240 0.006360
## 3 CARAÚBAS : MOSSORÓ 0.130000 0.130000
# Aprovacao e reprovacao - regressao logistica ----------------------------
pre_calc %>% as.data.frame %>% dplyr::select(`STATUS DA MATRÍCULA`, CAMPUS, `NR. FALTAS`, TURNO) %>%
filter(., `STATUS DA MATRÍCULA` %in% c("APROVADO", "REPROVADO")) -> pre_calc
pre_calc$`STATUS DA MATRÍCULA` = ifelse(pre_calc$`STATUS DA MATRÍCULA` == "APROVADO", 1, 0)
model <- glm(`STATUS DA MATRÍCULA`~., family = 'binomial', data=pre_calc)
summary(model)##
## Call:
## glm(formula = `STATUS DA MATRÍCULA` ~ ., family = "binomial",
## data = pre_calc)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.9037 -1.2692 0.6734 1.0883 1.8028
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 2.16416 0.57210 3.783 0.000155 ***
## CAMPUSCARAÚBAS -1.95085 0.58980 -3.308 0.000941 ***
## CAMPUSMOSSORÓ -1.23068 0.59915 -2.054 0.039971 *
## `NR. FALTAS` -0.13262 0.05429 -2.443 0.014580 *
## TURNONoturno -0.02764 0.54414 -0.051 0.959490
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 295.42 on 220 degrees of freedom
## Residual deviance: 274.00 on 216 degrees of freedom
## AIC: 284
##
## Number of Fisher Scoring iterations: 4
## Analysis of Deviance Table
##
## Model: binomial, link: logit
##
## Response: STATUS DA MATRÍCULA
##
## Terms added sequentially (first to last)
##
##
## Df Deviance Resid. Df Resid. Dev Pr(>Chi)
## NULL 220 295.42
## CAMPUS 2 14.4027 218 281.01 0.0007456 ***
## `NR. FALTAS` 1 7.0070 217 274.01 0.0081193 **
## TURNO 1 0.0026 216 274.00 0.9595164
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## Overall
## CAMPUSCARAÚBAS 3.30763143
## CAMPUSMOSSORÓ 2.05404538
## `NR. FALTAS` 2.44265271
## TURNONoturno 0.05079384
A distribuição geométrica é bastante utilizada para modelar “tempo de vida”, isto é, o número de tentativas até a ocorrência de uma falha. A função massa de probabilidade da distribuição geométrica é
\[P(X=x|p) = p(1-p)^{x-1},\,\, x = 1,2,\ldots \] Assim, nosso interesse consiste em, a partir dos dados, obter a estimativa de máxima verossimilhança do parâmetro \(p\), a probabilidade de sucesso. Com isso, podemos calcular a probabilidade de sucesso em cada tentativa para os três campi da UFERSA.
Seja \(X_1, \ldots, X_n\) uma amostra aleatória de uma distribuição geométrica. Temos que a função de verossimilhança é dada por
\[L(p) = p(1-p)^{x_1-1} p(1-p)^{x_2-1}\ldots p(1-p)^{x_n-1} = p^n(1-p)^{\sum_{i=1}^{n}x_i-n}\]
Assim, a logverossimilhança é dada por
\[l(p) = n\log{p} + \left(\sum_{i=1}^n x_i - n \right)\log{(1-p)}\]
Derivando em relação a \(p\) e igualando a zero, temos:
\[\frac{n}{p} - \frac{\left(\sum_{i=1}^n x_i - n\right)}{1-p} = 0\]
Finalmente,
\[\hat{p} = \frac{n}{\left(\sum_{i=1}^n x_i\right)} = \frac{1}{\bar{X}}\]
O valor esperado de uma variável aleatória com distribuição geométrica é dado por \(\frac{1}{p}\).
# Numero de tentativas ate a aprovacao em calculo -------------------------
pre_calculus %>% dplyr::select(DISCENTE, MATRÍCULA, ANO, PERÍODO,
DISCIPLINA, `STATUS DA MATRÍCULA`, MÉDIA, CURSO, CAMPUS, `NR. FALTAS`) %>%
filter(DISCIPLINA %in% c("CALCULO I", "CÁLCULO I",
"CALCULO I (1200003)", "CÁLCULO I (1200003)")) -> pre_calc
pre_calc$MATRÍCULA %>% unique -> matriculas_unicas
aluno <- matriculas_unicas[1]
dados_contagem = data.frame(tentativas=NA, campus=NA)
cont = 1
for(aluno in matriculas_unicas){
filtro1 = pre_calc %>% filter(MATRÍCULA == aluno)
if("APROVADO" %in% filtro1$`STATUS DA MATRÍCULA`){
#filtro1 %>% print #nrow %>% print
dados_contagem[cont,1] = filtro1 %>% nrow
dados_contagem[cont,2] = filtro1$CAMPUS %>% unique
cont = cont+1
}
}
#dados_contagem # Utilizar a dist geometrica para estimar prob de apro por campus --------
campi = unique(dados_contagem$campus)
for(i in campi){
print(i)
est = (dados_contagem %>% filter(campus==i) %>% dplyr::select(tentativas))[,1] %>% MASS::fitdistr(.,"geometric") %>% print
print("Valor esperado:")
print(1/est$estimate)
q <- data.frame(x = 0:10, prob = dgeom(x = 0:10, prob = est$estimate)) %>% ggplot(aes(x = factor(x), y = prob)) +
geom_col() + geom_text(aes(label = round(prob,2), y = prob + 0.01), position = position_dodge(0.9), size = 3, vjust = 0) +
labs(title = paste("Número de falhas até a primeira aprovação em Cálculo I - ", i),
subtitle = paste( "Distribuição geométrica, p = ", round(est$estimate, 2)),
x = "Tentativas até o primeiro sucesso (x)",
y = "Probabilidade")
print(q)
}## [1] "CARAÚBAS"
## prob
## 0.43209877
## (0.03891978)
## [1] "Valor esperado:"
## prob
## 2.314286
## [1] "MOSSORÓ"
## prob
## 0.4099379
## (0.0387610)
## [1] "Valor esperado:"
## prob
## 2.439394
## [1] "ANGICOS"
## prob
## 0.49056604
## (0.06866806)
## [1] "Valor esperado:"
## prob
## 2.038462
A Tabela abaixo lista todas as disciplinas cursadas pelos alunos que passaram pelo Cálculo I. São computados o número de matrículas na disciplina, excluindo os Status “MATRICULADO”, “INDEFERIDO” e “DISPENSADO”. Além disso, são apresentados o número de aprovações, desistências, trancamentos e exclusões. Finalmente, a taxa de aprovação \(t_a\) de cada disciplina é calculada como
\[t_a = \frac{Matrículas}{Aprovações}.\]
# Disciplinas com mais reprovacao (fizeram pré-calc) ----------------------
disciplinas = pre_calculus$DISCIPLINA %>% unique
disc_taxa_rep = data.frame(disciplina = NA, matriculas = NA, aprovacoes = NA,#)
desistencias=NA)#, trancamentos=NA, excluida=NA)
cont=1
for(d in disciplinas){
matriculas = pre_calculus %>% filter(DISCIPLINA == d & !(`STATUS DA MATRÍCULA` %in% c("MATRICULADO", "INDEFERIDO", "DISPENSADO"))) %>% nrow
aprovacoes = pre_calculus %>% filter(DISCIPLINA == d & `STATUS DA MATRÍCULA` == "APROVADO") %>% nrow
desistencias = pre_calculus %>% filter(DISCIPLINA == d & `STATUS DA MATRÍCULA` == "DESISTENCIA") %>% nrow
trancamentos = pre_calculus %>% filter(DISCIPLINA == d & `STATUS DA MATRÍCULA` == "TRANCADO" &
!(`STATUS DA MATRÍCULA` %in% c("MATRICULADO", "INDEFERIDO", "DISPENSADO"))) %>% nrow
excluida = pre_calculus %>% filter(DISCIPLINA == d & `STATUS DA MATRÍCULA` == "EXCLUIDA" &
!(`STATUS DA MATRÍCULA` %in% c("MATRICULADO", "INDEFERIDO", "DISPENSADO"))) %>% nrow
disc_taxa_rep[cont, 1] = d
disc_taxa_rep[cont, 2] = matriculas
disc_taxa_rep[cont, 3] = aprovacoes
disc_taxa_rep[cont, 4] = desistencias
#disc_taxa_rep[cont, 5] = trancamentos
#disc_taxa_rep[cont, 6] = excluida
cont = cont + 1
}
disc_taxa_rep %>% mutate(., taxa_aprovacao = round(aprovacoes/matriculas, 2)) %>% arrange(taxa_aprovacao) -> disc_taxa_rep
DT::datatable(disc_taxa_rep, options=list(autoWidth = TRUE, columnDefs = list(list(visible=FALSE)), scrollX = TRUE))Desenvolvido por Kássio Camelo
kassio.silva@ufersa.edu.br