Commit 45a64f7d authored by Walmes Marques Zeviani's avatar Walmes Marques Zeviani
Browse files

Adds the grades.

parent 7df8268f
---
title: Notas das Avaliações
output:
html_document:
toc: false
---
```{r, include = FALSE}
#-----------------------------------------------------------------------
# Pacotes.
rm(list = objects())
library(tidyverse)
#-----------------------------------------------------------------------
# Funções.
# Determina a média das sabatinas usando as k maiores notas.
my_mean <- function(x, keep = floor(length(x) * 0.75), ...) {
#
# @param x numeric[n > 0] vetor com notas nas sabatinas.
#
# @param keep integer[1] número de sabatinas que serão consideradas
# para calculo da média.
#
# @return numeric[1] a média calculada.
#
sum(head(sort(x, decreasing = TRUE), n = keep), ...)/keep
}
my_mean(c(1:8, NA, NA, NA), keep = 2)
# Usa distância de edição para parear os nomes das duas fontes.
my_match <- function(x, y, min.match = 2) {
#
# @param x character[n > 0] vetor de strings.
#
# @param y character[m > 0] vetor de strings.
#
# @param min.match integer[1] > 0 número minimo de nomes que dever
# coincidir.
#
# @return data.frame com os vetores pareados.
#
xs <- strsplit(x, split = "\\s+")
ys <- strsplit(y, split = "\\s+")
m <- character(length(x))
for (i in seq_along(x)) {
j <- sapply(ys,
FUN = function(z) {
u <- c(adist(z, xs[[i]]))
(sum(u == 0) >= min.match)
})
if (any(j)) {
a <- adist(y[j], x[i])
m[i] <- y[j][which.min(a)]
}
}
m[m == ""] <- NA
data.frame(template = x, match = m, stringsAsFactors = FALSE)
}
my_match(c("Walmes Zeviani", "Ronald Fisher"),
c("Fisher", "Walmes"),
min.match = 1)
#-----------------------------------------------------------------------
# Matrícula.
path <- "/home/walmes/Dropbox/Ensino/ce064-2018-02-ML/"
x <- gdata::read.xls(paste0(path, "RelatoriodeDiariodeClasseExcel.xls"),
encoding = "latin1",
stringsAsFactors = FALSE,
skip = 6)
v <- names(x) %in% c("Matrícula", "Nome", "Faltas")
mat <- x %>%
select(names(x)[v]) %>%
filter(grepl("\\d$", Matrícula)) %>%
as_tibble() %>%
rename("GRR" = "Matrícula", "nome" = "Nome") %>%
mutate(GRR = str_replace(GRR, "\\D+", "") %>% as.integer())
str(mat)
#-----------------------------------------------------------------------
# Notas do moodle.
# Importação.
nt <- read_csv(paste0(path, "notas.csv"),
locale = locale(decimal_mark = "."),
na = c("", "-"))
attr(nt, "spec") <- NULL
str(nt)
# Seleção de variáveis de nome e notas nas sabatinas.
nt <- nt %>%
select(contains("nome"),
contains("sabatina"),
contains("trabalho"))
str(nt)
# Exclui usuários que não são alunos.
nt <- nt %>%
filter(!grepl("walmes", Nome, ignore.case = TRUE))
str(nt)
# Renomeia variáveis.
names(nt) <- names(nt) %>%
str_replace(".*(Sabatina.*Q?\\d+).*", "\\1") %>%
str_replace(".*(Trabalho.*\\d).*", "\\1") %>%
tolower()
# Junta nomes para formar o nome completo.
nt <- nt %>%
unite(col = "nome", nome, sobrenome, sep = " ")
str(nt)
# dput(names(nt))
names(nt) <- c("nome",
sprintf("sabatina %02d", 1:9),
"trabalho")
#-----------------------------------------------------------------------
# Tratamento das sabatinas.
# Empilha nas sabatinas.
ntg <- nt %>%
gather(key = "sabatina",
value = "nota",
contains("sabatina"))
if (is.character(ntg$nota)) {
ntg$nota <- as.numeric(ntg$nota)
}
str(ntg)
# Elimina o sulfixo que é da questão na sabatina.
ntg <- ntg %>%
mutate(sabatina = str_match(sabatina, "sabatina \\d+"),
nota = replace_na(nota, replace = 0))
str(ntg)
# Calcula as notas média por sabatina pro caso de ter mais de uma
# questão.
ntg <- ntg %>%
group_by(nome, sabatina) %>%
summarise(nota = sum(nota, na.rm = TRUE)/n()) %>%
ungroup()
str(ntg)
# Devolve para o formado com sabatinas em cada coluna.
nts <- ntg %>%
mutate(nota = round(nota, digits = 2)) %>%
spread(key = "sabatina", value = "nota")
str(nts)
# Ordena as colunas sabatinas por ordem cronológica.
i <- grep(x = names(nts), pattern = "sabatina")
j <- as.integer(gsub(x = names(nts)[i],
pattern = "\\D",
replacement = ""))
nts <- nts %>%
select(names(nts)[-i], i[order(j)])
# Nota das sabatinas mantendo as k maiores notas.
ntg <- ntg %>%
group_by(nome) %>%
summarise(S_escore = my_mean(nota, keep = 6, na.rm = TRUE)) %>%
ungroup()
str(ntg)
# Junção da nota média com as sabatinas.
nts <- nts %>%
inner_join(ntg)
str(nts)
# Encurta nomes.
names(nts) <- names(nts) %>%
str_replace("sabatina ", "S")
str(nts)
#-----------------------------------------------------------------------
# Notas do trabalho.
ntt <- nt %>%
select(nome, contains("trabalho")) %>%
mutate_if(is.numeric, function(x) replace_na(x, replace = 0))
ntt
# Ordena as colunas sabatinas por ordem cronológica.
i <- grep(x = names(ntt), pattern = "trabalho")
j <- as.integer(gsub(x = names(ntt)[i],
pattern = "\\D",
replacement = ""))
ntt <- ntt %>%
select(names(ntt)[-i], i[order(j)])
str(ntt)
# Encurta nomes.
names(ntt) <- names(ntt) %>%
str_replace("trabalho", "Trab")
str(ntt)
#-----------------------------------------------------------------------
# Junção da sabatina com as notas e média final.
ntst <- inner_join(nts, ntt)
ntst
# Caixa alta nos nomes e arredondamento.
ntst <- ntst %>%
mutate(nome = toupper(nome),
S_escore = ceiling(S_escore))
str(ntst)
ntst <- ntst %>%
mutate(Média = 0.6 * S_escore + 0.4 * Trab,
Média = ceiling(Média))
# View(arrange(ntst, S_escore))
# View(arrange(ntst, Média))
nt <- ntst
#-----------------------------------------------------------------------
# Pareamento do GRR para colocar na tabela.
# Faz o pareamento dos nomes.
a <- my_match(x = nt$nome, mat$nome)
str(a)
# Junção completa para inclusão do GRR.
a <- full_join(a, mat, by = c("match" = "nome"))
i <- is.na(a$match)
a$match[i] <- a$template[i]
# Acrescenta GRR a tabela com as notas.
nt <- inner_join(nt, a, by = c("nome" = "template"))
str(nt)
# Nomes que estão sem GRR para preencher manualmente na xlsx.
nt %>%
filter(is.na(GRR)) %>%
select(nome) %>%
print(right = FALSE, row.names = FALSE, print.gap = FALSE)
nt <- nt %>%
filter(!is.na(GRR))
#-----------------------------------------------------------------------
# Tabela em HTML.
library(DT)
cap <- "Notas nas avaliações (S: sabatina) ordenadas pelo GRR. Valores entre 0 e 100. Foram consideradas as 6 maiores notas nas sabatinas, de um total de 10, para obtenção do `S_escore`. A nota do trabalho 1 teve peso 1/10, o trabalho 2 teve peso 2/10 e as sabatinas 7/10 para a média."
if (require(htmltools)) {
cap <- HTML("<strong>Tabela 1</strong>:", cap)
}
i <- c(grep(x = names(nt), "GRR"),
grep(x = names(nt), "^S"),
grep(x = names(nt), "^T"),
grep(x = names(nt), "Faltas"),
grep(x = names(nt), "Média"))
dt <- datatable(data = select(nt, i),
filter = "top",
caption = cap,
rownames = FALSE,
autoHideNavigation = TRUE,
escape = FALSE,
options = list(
searching = FALSE,
paging = FALSE,
pageLength = NULL,
lengthMenu = NULL))
# dt
dt <- formatStyle(table = dt,
columns = grepl("^(S|T|M)", names(dt$x$data)),
color = styleInterval(cuts = c(39.999999,
69.999999),
values = c("#ff3300",
"gray",
"#3333ff")))
if (is.element("Faltas", names(dt$x$data))) {
dt <- formatStyle(table = dt,
columns = "Faltas",
color = styleInterval(cuts = c(15),
values = c("#3333ff",
"#ff3300")))
}
dt
```
```{r, echo = FALSE, fig.cap = cap}
#-----------------------------------------------------------------------
# Visualização.
cap <- "**Figura 1**: Escore final das sabatinas em função do GRR. Cores indicam grupos conforme corte do escore em classes com limites em 40 e 70."
cap <- "**Figura 1**: Média em função do GRR. Cores indicam grupos conforme corte da nota em classes com limites em 40 e 70."
# # Acumulada empírica.
# ggplot(nts, aes(x = S_escore)) +
# stat_ecdf() +
# xlim(0, 100)
ggplot(data = nt,
mapping = aes(x = Média,
color = cut(Média,
breaks = c(0, 40, 70, 100),
include.lowest = TRUE, right = FALSE),
y = reorder(GRR, Média))) +
geom_point() +
geom_text(mapping = aes(label = Média),
nudge_x = 3.5,
size = 4) +
xlab("Nota média") +
ylab("GRR (ordenado)") +
# geom_vline(xintercept = c(40, 70),
# linetype = 3,
# lwd = 0.5) +
scale_color_discrete(guide = FALSE) +
xlim(0, 100)
```
```{r, echo = FALSE, fig.cap = cap, message = FALSE, warning = FALSE, results = "hide"}
ggplot(data = nt,
mapping = aes(y = S_escore,
x = Faltas)) +
geom_jitter(height = 0, width = 0.5) +
geom_smooth(se = FALSE, span = 0.8, color = "gray50")
# Correlação de Spearman.
x <- with(nt, cor.test(x = S_escore, y = Faltas, method = "spearman"))
x$p.value
cap <- "**Figura 2**: Diagrama de dispersão que relaciona o escore final nas sabatinas e o número de faltas de cada aluno (Correlação de Spearman: rho = %0.2f, valor p = %0.3g)."
cap <- sprintf(cap, x$estimate, x$p.value)
```
```{r, include = FALSE, eval = FALSE, echo = FALSE, results = "hide", fig.cap = cap}
#-----------------------------------------------------------------------
# Análise multivariada das notas.
# X <- as.matrix(nts[, grepl("^S\\d", names(nts))])
X <- as.matrix(nt[, grepl("^(S|T)\\d", names(nt))])
# rownames(X) <- gsub("^([^ ]+)\\s.*", "\\1", nts$nome)
rownames(X) <- nt$GRR
str(X)
#--------------------------------------------
# Componentes principais.
pca <- princomp(x = X)
summary(pca)
pca$loadings
# screeplot(pca, type = "lines")
# biplot(pca)
#--------------------------------------------
# Agrupamento hierárquico.
cap <- "**Figura 3**: Agrupamento hierárquico dos GRRs baseado nas distâncias entre os vetores de notas das 10 sabatinas."
d <- dist(X)
hc <- hclust(d = d)
plot(hc,
hang = -1,
cex = 0.8,
main = NULL,
sub = "",
xlab = "GRR",
ylab = "Similaridade")
```
```{r, eval = FALSE, echo = FALSE, results = "asis"}
x <- knitr::kable(nt,
caption = cap,
row.names = FALSE,
na.string = "",
align = c("c", "c"))
cat(gsub("\\bNA\\b", "--", x), sep = "\n")
```
<style type="text/css">
/* ATTENTION: propriedades da tabela do DT::datatable() */
table.dataTable thead th,
table.dataTable thead td {
padding: 3px 6px;
}
table.dataTable tbody th,
table.dataTable tbody td {
padding: 1px 6px;
}
table.dataTable th.dt-right,
table.dataTable td.dt-right {
text-align: center;
}
</style>
```{r, echo = FALSE, results = "asis"}
# dt
is.decimal <- function(x) is.numeric(x) && !is.integer(x)
formatRound(table = dt,
columns = sapply(dt$x$data, FUN = is.decimal),
digits = 1)
```
<!--
\* A média final é uma média ponderada da nota das sabatinas (peso 0.6)
e dos trabalhos (peso 0.4). Foram realizadas 9 sabatinas e 2 questões
bonus. Destas 11 notas, apenas as 6 maiores ($\left\lfloor 0.75 \times 9
\right\rfloor = 6$) foram consideradas para compor o desempenho nas
sabatinas. A nota do T2 foi lançada como 70 para todos os alunos apenas
para fins de simulação. Em breve, a nota correta será lançada.
-->
```{r, include = FALSE, eval = FALSE}
# Ajuste da nota do trabalho 2.
# Importa a tabela com a nota do trabalho e o escore em cada quesito
# avaliado do trabalho.
da <- read.table("clipboard", header = TRUE, sep = "\t")
str(da)
m0 <- lm(nota ~ . - grupo, data = da)
par(mfrow = c(2, 2))
plot(m0)
layout(1)
drop1(m0, test = "F")
summary(m0)
cbind(fit = fitted(m0),
fit_round = round(fitted(m0)/5) * 5,
fit_ceil = ceiling(fitted(m0)/5) * 5,
obs = da$nota)
# Nota ajustada.
cat(ceiling(fitted(m0)/5) * 5, sep = "\n")
```
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment