From 5093b0602d486f5f4be651da2b9161ea18f127ec Mon Sep 17 00:00:00 2001
From: Walmes Zeviani <walmes@ufpr.br>
Date: Sat, 10 Nov 2018 20:59:37 -0200
Subject: [PATCH] Inclui as notas.
---
_site.yml | 6 +-
notas.Rmd | 441 ++++++++++++++++++++++++++++--------------------------
2 files changed, 229 insertions(+), 218 deletions(-)
diff --git a/_site.yml b/_site.yml
index 7b0f17d..c20a4a5 100644
--- a/_site.yml
+++ b/_site.yml
@@ -82,9 +82,9 @@ navbar:
# - text: "Scripts"
# icon: fa-file-text
# href: scripts/index.html
-# - icon: fa-line-chart
-# text: "Notas"
-# href: notas.html
+ - icon: fa-line-chart
+ text: "Notas"
+ href: notas.html
# - icon: fa-archive
# text: "Arquivos"
# href: data/
diff --git a/notas.Rmd b/notas.Rmd
index 4bdd889..dc4a5fa 100644
--- a/notas.Rmd
+++ b/notas.Rmd
@@ -7,198 +7,260 @@ output:
```{r, include = FALSE}
#-----------------------------------------------------------------------
-# Funções.
+# Pacotes.
rm(list = objects())
-
-# Colore as cédulas da tabela de acordo com a classe da nota.
-cel_color <- function(x,
- breaks = c(0, 50, 70, 100),
- colors = c("red", "orange", "green")) {
- z <- cut(x = x,
- breaks = breaks,
- right = FALSE,
- include.lowest = TRUE)
- sprintf("<span style=\"color: %s;\">%0.1f</span>",
- colors[as.integer(z)],
- x)
-}
-# cel_color(c(0, 35, 40, 45, 70, 100))
+library(gdata)
+library(tidyverse)
#-----------------------------------------------------------------------
-# Leitura.
+# MatrÃcula.
+
+path <- "/home/walmes/Dropbox/Ensino/ce089-2018-02/"
+x <- read.xls(paste0(path, "RelatoriodeDiariodeClasseExcel.xls"),
+ encoding = "latin1",
+ stringsAsFactors = FALSE,
+ skip = 6)
+
+mat <- x %>%
+ select(c("MatrÃcula", "Nome")) %>%
+ filter(grepl("\\d$", MatrÃcula)) %>%
+ as_tibble() %>%
+ setNames(c("GRR", "nome")) %>%
+ mutate(GRR = str_replace(GRR, "\\D+", "") %>% as.integer())
+str(mat)
-library(gdata)
-library(latticeExtra)
-library(EnvStats)
+#-----------------------------------------------------------------------
+# Notas do moodle.
-nt <- read.xls("/home/walmes/Dropbox/Ensino/ce089-2017-02/notas.xls",
- sheet = 1,
- stringsAsFactors = FALSE,
- encoding = "latin1")
+# Importação.
+nt <- read_csv(paste0(path, "historico_de_notas.csv"),
+ locale = locale(decimal_mark = ","))
+attr(nt, "spec") <- NULL
str(nt)
-nt$Nome <- paste(
- sub(pattern = "^(\\w+) .*$",
- replacement = "\\1",
- x = nt$Nome),
- sub(pattern = "^\\w.* (\\w+)$",
- replacement = "\\1",
- x = nt$Nome))
+# Seleção de variáveis.
+nt <- nt %>%
+ select(`Data e hora`:`Nota revisada`)
+str(nt, give.attr = FALSE)
+
+# Renomeia variáveis.
+names(nt) <- c("ts", "nome", "email", "item", "orig", "revis")
+
+# Filtro para as notas das sabatinas.
+nt <- nt %>%
+ filter(grepl("^Sabatina", item),
+ !grepl("walmes", nome, ignore.case = TRUE))
+str(nt, give.attr = FALSE)
+
+# Cria a estampa de tempo para ordenação.
+ts_fmt <- "%A, %d %b %Y, %H:%M"
+nt$ts <- as.POSIXct(nt$ts, format = ts_fmt)
+
+# Ordena em nome > item > ts.
+nt <- nt %>%
+ arrange(nome, item, ts)
+
+# Agrupa pegando o último registro por avaliação.
+ntg <- nt %>%
+ group_by(nome, item) %>%
+ summarise(nota = last(revis)) %>%
+ ungroup()
+str(ntg)
+
+# Para verificar a escala de variação das notas.
+# ntg %>%
+# group_by(item) %>%
+# summarise(min = min(nota, na.rm = TRUE),
+# max = max(nota, na.rm = TRUE))
+
+# Cria a variável indentificadora da sabatina ao separar texto.
+ntg <- ntg %>%
+ separate(col = "item",
+ into = c("S", "Q"),
+ sep = " - ")
+str(ntg)
+
+# Passa notas para escala 0 - 100.
+ntg$nota <- ifelse(ntg$S == "Sabatina 10", yes = 100, no = 10) * ntg$nota
+
+# Calcula a média por sabatina e converte NA/NaN para 0.
+ntg <- ntg %>%
+ group_by(nome, S) %>%
+ summarise(nota = round(mean(nota, na.rm = TRUE), digits = 1),
+ nota = replace_na(nota, replace = 0))
+str(ntg, give.attr = FALSE)
+
+# Determina a média das sabatinas usando as k maiores notas.
+my_mean <- function(x, keep = floor(length(x) * 0.75)) {
+ mean(head(sort(x, decreasing = TRUE), n = keep))
+}
+
+# Média nas sabatinas.
+ms <- ntg %>%
+ summarise(S_escore = my_mean(nota)) %>%
+ ungroup()
+# ms
+
+# Obtém formato com as notas das sabatinas nas colunas.
+ntgw <- ntg %>%
+ mutate(S = str_replace(S, "Sabatina ", "S")) %>%
+ spread(key = "S", value = "nota") %>%
+ ungroup()
+
+# Junta a média com as notas por sabatina.
+nts <- inner_join(x = ntgw, y = ms) %>%
+ mutate(nome = toupper(nome),
+ S_escore = round(S_escore, digits = 0))
#-----------------------------------------------------------------------
-# Editação da tabela.
-
-# Cria GRR.
-nt$grr <- as.integer(gsub("\\D", "", nt$MatrÃcula))
-
-# Ordena.
-nt <- plyr::arrange(nt, grr)
-# nt <- plyr::arrange(nt, Nome)
-
-# Notas das sabatinas, provas, trabalhos, exame e faltas.
-index <- list()
-index$s <- grep("^S\\d+$", names(nt), value = TRUE)
-index$p <- grep("^P\\d+$", names(nt), value = TRUE)
-index$b <- grep("^B\\d+$", names(nt), value = TRUE)
-index$t <- grep("^T\\d+$", names(nt), value = TRUE)
-index$e <- grep("^E$", names(nt), value = TRUE)
-index$f <- grep("^F$", names(nt), value = TRUE)
-# index
-
-# Quantas sabatinas aproveitar?
-if (length(index$s) >= 4) {
- ns <- floor(length(index$s) * 0.75)
-} else {
- ns <- length(index$s)
+# Pareamento do GRR para colocar na tabela.
+
+# Usa distancia de edição para parear os nomes das duas fontes.
+my_match <- function(x, y) {
+ 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) >= 2)
+ })
+ 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)
}
-# Pesos de cada forma de avaliação.
-pesos <- c(s = 0.6, p = 0, t = 0.4)
+# Faz o pareamento dos nomes.
+a <- my_match(x = nts$nome, mat$nome)
+str(a)
-# Colunas de notas presentes.
-u <- unlist(index[1:4])
+# 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.
+nts <- inner_join(nts, a, by = c("nome" = "template"))
+
+# # Nota necessária no trabalho para ficar com média >= 40.
+# u <- (40 - 0.7 * nts$S_escore)/0.3
+# data.frame(nts$nome, nts$S_escore, u = ifelse(u > 0, u, 0))
+
+# Mantém só registros com GGR.
+nts <- nts %>%
+ filter(!is.na(GRR))
#-----------------------------------------------------------------------
-# Cálculos.
-
-# ATTENTION. Considera como sabatina até as questões bonus.
-index$s <- grep("^[SB]\\d+$", names(nt), value = TRUE)
-
-# Calcula a média nas sabatinas.
-if (length(index$s) > 1) {
- nt$ms <- apply(X = cbind(nt[, c(index$s)]),
- MARGIN = 1,
- FUN = function(x) {
- sum(sort(x[index$s],
- na.last = TRUE,
- decreasing = TRUE)[1:ns],
- na.rm = TRUE)/ns
- })
-}
+# Tabela em HTML.
-# Calcula a média nas provas.
-if (length(index$p)) {
- nt$mp <- apply(X = cbind(nt[, c(index$p)]),
- MARGIN = 1,
- FUN = sum,
- na.rm = TRUE)/length(index$p)
-} else {
- message("Sem notas de provas.")
-}
+# nt$Nome <- paste(
+# sub(pattern = "^(\\w+) .*$",
+# replacement = "\\1",
+# x = nt$Nome),
+# sub(pattern = "^\\w.* (\\w+)$",
+# replacement = "\\1",
+# x = nt$Nome))
-# Calcula a média nos trabalhos.
-if (length(index$t)) {
- nt$mt <- apply(X = cbind(nt[, c(index$t)]),
- MARGIN = 1,
- FUN = sum,
- na.rm = TRUE)/length(index$t)
-} else {
- message("Sem notas de trabalhos.")
-}
+library(DT)
-# Calcula a média final antes do exame.
-j <- c("ms", "mp", "mt")
-a <- j %in% names(nt)
-j <- j[a]
-pesos <- pesos[a]
-
-# Se existir alguma das médias, obter a média parcial.
-if (length(pesos)) {
- # Reescala os pesos.
- pesos <- pesos/sum(pesos)
- stopifnot(as.integer(sum(pesos)) == 1L)
- nt$MF1 <- c(as.matrix(nt[, j]) %*% cbind(pesos))
-}
+cap <-
+ "Notas nas avaliações (S: sabatina) ordenadas pelo GRR. Valores entre 0 e 100.*"
-# Calcula a média final depois do exame.
-if (!is.null(nt$MF1) & !is.null(nt$E)) {
- nt$MF2 <- with(nt, {
- i <- MF1 >= 40 & MF1 < 70
- MF2 <- MF1
- MF2[i] <- rowSums(cbind(MF1[i], E[i]), na.rm = TRUE)/2
- c(MF2)
- })
-}
+dt <- datatable(data = select(nts, "GRR", contains("S")),
+ filter = "top",
+ caption = cap,
+ rownames = FALSE,
+ autoHideNavigation = TRUE,
+ escape = FALSE,
+ options = list(
+ searching = FALSE,
+ paging = FALSE,
+ pageLength = NULL,
+ lengthMenu = NULL))
+# str(dt$x$data)
-# Média mais recente.
-v <- c("ms", "MF1", "MF2")
-v <- tail(v[v %in% names(nt)], n = 1)
+dt <- formatStyle(table = dt,
+ columns = grepl("^S", names(dt$x$data)),
+ color = styleInterval(cuts = c(39.999999,
+ 69.999999),
+ values = c("#ff3300",
+ "gray",
+ "#3333ff")))
+dt
+```
+
+```{r, echo = FALSE, fig.cap = cap}
#-----------------------------------------------------------------------
-# Os melhores desempenhos.
-
-# Não tem necessidade de usar isso se a exibição for com o pacote
-# datatable.
-
-nt$GRR <- nt$grr
-
-# k <- 5
-# if (length(v) == 1L) {
-# r <- rank(-nt[, v], ties.method = "first")
-# i <- r <= k
-# # nt$topk <- ""
-# # nt$topk[i] <- paste0("<sup style=\"color: cyan;\">",
-# # r[i],
-# # "</sup>")
-# nt[i, "GRR"] <- paste0(nt[i, "grr"],
-# "<sup style=\"color: blue;\">",
-# r[i],
-# "</sup>")
-# }
+# Visualização.
+
+cap <- "Escore final das sabatinas em função do GRR. Cores indicam grupos conforme corte do escore classes."
+
+# # Acumulada empÃrica.
+# ggplot(nts, aes(x = S_escore)) +
+# stat_ecdf() +
+# xlim(0, 100)
+
+ggplot(data = nts,
+ mapping = aes(x = S_escore,
+ color = cut(S_escore,
+ breaks = c(0, 40, 70, 100),
+ include.lowest = TRUE, right = FALSE),
+ y = reorder(GRR, S_escore))) +
+ geom_point() +
+ geom_text(mapping = aes(label = S_escore),
+ nudge_x = 3.5,
+ size = 4) +
+ xlab("Escore final nas sabatinas") +
+ ylab("GRR (ordenado pela escore)") +
+ # geom_vline(xintercept = c(40, 70),
+ # linetype = 3,
+ # lwd = 0.5) +
+ scale_color_discrete(guide = FALSE) +
+ xlim(0, 100)
+```
+```{r, eval = FALSE, echo = FALSE, results = "hide", fig.cap = cap}
#-----------------------------------------------------------------------
-# Colorir as médias?
+# Análise multivariada das notas.
-# TODO. Ver o que foi feito para MinTex.
-# Criar média parcial e média final
+X <- as.matrix(nts[, grepl("^S\\d", names(nts))])
+# rownames(X) <- gsub("^([^ ]+)\\s.*", "\\1", nts$nome)
+rownames(X) <- nts$GRR
+str(X)
-if (!is.null(nt$MF1)) {
- # nt$"M. parcial" <- cel_color(nt$MF1, breaks = c(0, 40, 70, 100))
- nt$"M. parcial" <- nt$MF1
-}
-if (!is.null(nt$MF2)) {
- # nt$"M. final" <- cel_color(nt$MF2, breaks = c(0, 50, 100))
- nt$"M. final" <- nt$MF2
-}
+#--------------------------------------------
+# Componentes principais.
-# Verifica se o aluno está aprovado.
-if (!is.null(nt$"M. final") & !is.null(nt$E) & !is.null(nt$F)) {
- nt$A <- ifelse(nt$"M. final" >= 50 &
- nt$F <= 15, "A", "R")
-}
+pca <- princomp(x = X)
+summary(pca)
-#-----------------------------------------------------------------------
+pca$loadings
-v <- c("GRR", u, c("M. parcial", "E", "M. final", "F", "A"))
-v <- v[v %in% names(nt)]
+# screeplot(pca, type = "lines")
+# biplot(pca)
-# nt <- plyr::arrange(nt, -mp)
-# nt <- plyr::arrange(nt, Nome)
+#--------------------------------------------
+# Agrupamento hierárquico.
-# Legenda da tabela.
-cap <-
- "Notas nas avaliações (S: sabatina, B: sabatina bonus, T: trabalho) ordenadas pelo GRR. Valores entre 0 e 100.*"
+cap <- "Agrupamento hierárquico dos GRR baseado nas distâncias entre os vetores de notas das 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"}
@@ -229,70 +291,19 @@ table.dataTable td.dt-right {
</style>
```{r, echo = FALSE, results = "asis"}
-# browseURL("http://datatables.net/reference/option/")
-# http://rstudio.github.io/DT/functions.html
-# help(datatable, h = "html")
-# help(formatStyle, h = "html")
-library(DT)
-
-dt <- datatable(data = subset(nt, select = v),
- filter = "top",
- caption = cap,
- rownames = FALSE,
- autoHideNavigation = TRUE,
- escape = FALSE,
- options = list(
- searching = FALSE,
- paging = FALSE,
- pageLength = NULL,
- lengthMenu = NULL))
-
-dt <- formatStyle(table = dt,
- columns = !(v %in% c("Nome",
- "GRR",
- "F",
- "M. final",
- "A")),
- color = styleInterval(cuts = c(39.999999,
- 69.999999),
- values = c("#ff3300",
- "gray",
- "#3333ff")))
-
-if ("E" %in% v) {
- dt <- formatStyle(table = dt,
- columns = (v %in% c("M. final")),
- color = styleInterval(cuts = c(49.999999),
- values = c("#ff3300",
- "#3333ff")))
-}
-
-if ("F" %in% v) {
- dt <- formatStyle(table = dt,
- columns = (v %in% c("F")),
- color = styleInterval(cuts = c(16),
- values = c("#ff3300",
- "#3333ff")[2:1]))
-}
-
-if ("A" %in% v) {
- dt <- formatStyle(table = dt,
- columns = (v %in% c("A")),
- color = styleEqual(levels = c("R", "A"),
- values = c("#ff3300",
- "#3333ff")))
-}
+# 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.
+-->
--
GitLab