diff --git a/notas.Rmd b/notas.Rmd
index c65aad7df2b6392746eac9d585de6cd8731342a6..f8a7bc061ebff072bac3cae1f6032f7ed03182d2 100644
--- a/notas.Rmd
+++ b/notas.Rmd
@@ -10,9 +10,58 @@ output:
# Pacotes.
rm(list = objects())
-# library(gdata)
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.
@@ -35,116 +84,144 @@ str(mat)
# Notas do moodle.
# Importação.
-nt <- read_csv(paste0(path, "historico_de_notas.csv"),
- locale = locale(decimal_mark = ","))
+nt <- read_csv(paste0(path, "notas.csv"),
+ locale = locale(decimal_mark = "."),
+ na = c("", "-"))
attr(nt, "spec") <- NULL
str(nt)
-# Seleção de variáveis.
+# Seleção de variáveis de nome e notas nas sabatinas.
nt <- nt %>%
- select(`Data e hora`:`Nota revisada`)
+ select(contains("nome"),
+ contains("sabatina"),
+ contains("trabalho"))
str(nt)
-# Renomeia variáveis.
-names(nt) <- c("ts", "nome", "email", "item", "orig", "revis")
-
-# Filtro para as notas das sabatinas.
+# Exclui usuários que não são alunos.
nt <- nt %>%
- filter(grepl("^Sabatina", item),
- !grepl("walmes", nome, ignore.case = TRUE))
+ filter(!grepl("walmes", Nome, ignore.case = TRUE))
str(nt)
-# Cria a estampa de tempo para ordenação cronológica dos registros.
-ts_fmt <- "%A, %d %b %Y, %H:%M"
-nt$ts <- as.POSIXct(nt$ts, format = ts_fmt)
+# Renomeia variáveis.
+names(nt) <- names(nt) %>%
+ str_replace(".*(Sabatina.*Q?\\d+).*", "\\1") %>%
+ str_replace(".*(Trabalho.*\\d).*", "\\1") %>%
+ tolower()
-# Ordena em nome > item > ts.
+# Junta nomes para formar o nome completo.
nt <- nt %>%
- arrange(nome, item, ts)
+ unite(col = "nome", nome, sobrenome, sep = " ")
+str(nt)
+
+#-----------------------------------------------------------------------
+# Tratamento das sabatinas.
-# Agrupa pegando o último registro por sabatina.
+# Empilha nas sabatinas.
ntg <- nt %>%
- group_by(nome, item) %>%
- summarise(nota = last(revis)) %>%
- ungroup()
+ gather(key = "sabatina",
+ value = "nota",
+ contains("sabatina"))
+if (is.character(ntg$nota)) {
+ ntg$nota <- as.numeric(ntg$nota)
+}
str(ntg)
-# Para verificar a amplitude de escala das notas.
-# ntg %>%
-# group_by(item) %>%
-# summarise(min = min(nota, na.rm = TRUE),
-# max = max(nota, na.rm = TRUE))
+# Passa notas para escala 0 - 100.
+ntg$nota <- ntg$nota * 10
-# Quebra texto em duas variáveis para ter sabatina e questão.
+# Elimina o sulfixo que é da questão na sabatina.
ntg <- ntg %>%
- separate(col = "item",
- into = c("S", "Q"),
- sep = " - ")
+ mutate(sabatina = str_match(sabatina, "sabatina \\d+"),
+ nota = replace_na(nota, replace = 0))
str(ntg)
-# Passa notas para escala 0 - 100.
-ntg$nota <- ntg$nota * 10
-
-# Calcula a média por sabatina e converte NA/NaN para 0.
+# Calcula as notas média por sabatina pro caso de ter mais de uma
+# questão.
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)
+ group_by(nome, sabatina) %>%
+ summarise(nota = sum(nota, na.rm = TRUE)/n()) %>%
+ ungroup()
+str(ntg)
-# 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))
-}
+# 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)])
-# Média nas sabatinas.
-ms <- ntg %>%
- # summarise(k6 = my_mean(nota, keep = 6),
- # k7 = my_mean(nota, keep = 7)) %>%
- summarise(S_escore = my_mean(nota, keep = 6)) %>%
+# 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()
-# ms
+str(ntg)
-# plot(k6 ~ k7, data = ms, asp = 1)
-# abline(a = 0, b = 1)
-# sort(with(ms, (k6 - k7)/k7))
+# Junção da nota média com as sabatinas.
+nts <- nts %>%
+ inner_join(ntg)
+str(nts)
-# 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()
+# 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 ", "T")
+str(ntt)
+
+#-----------------------------------------------------------------------
+# Junção da sabatina com as notas e média final.
-# Junta a média com as notas por sabatina.
-nts <- inner_join(x = ntgw, y = ms) %>%
+ntst <- inner_join(nts, ntt)
+ntst
+
+# Caixa alta nos nomes e arredondamento.
+ntst <- ntst %>%
mutate(nome = toupper(nome),
- S_escore = round(S_escore, digits = 0))
+ S_escore = ceiling(S_escore))
+str(ntst)
+
+ntst <- ntst %>%
+ mutate(Média = 0.7 * S_escore + 0.1 * T1 + 0.2 * T2,
+ Média = ceiling(Média))
+
+# View(arrange(ntst, S_escore))
+# View(arrange(ntst, média))
+
+nt <- ntst
#-----------------------------------------------------------------------
# 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)
-}
-
# Faz o pareamento dos nomes.
-a <- my_match(x = nts$nome, mat$nome)
+a <- my_match(x = nt$nome, mat$nome)
str(a)
# Junção completa para inclusão do GRR.
@@ -153,27 +230,32 @@ 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"))
+nt <- inner_join(nt, a, by = c("nome" = "template"))
+str(nt)
-# # 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))
+# 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)
#-----------------------------------------------------------------------
# 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."
+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)
}
-dt <- datatable(data = select(nts, "GRR", contains("S"), contains("Faltas")),
+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,
@@ -184,9 +266,10 @@ dt <- datatable(data = select(nts, "GRR", contains("S"), contains("Faltas")),
paging = FALSE,
pageLength = NULL,
lengthMenu = NULL))
+# dt
dt <- formatStyle(table = dt,
- columns = grepl("^S", names(dt$x$data)),
+ columns = grepl("^(S|T|M)", names(dt$x$data)),
color = styleInterval(cuts = c(39.999999,
69.999999),
values = c("#ff3300",
@@ -210,23 +293,25 @@ dt
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 = nts,
- mapping = aes(x = S_escore,
- color = cut(S_escore,
+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, S_escore))) +
+ y = reorder(GRR, Média))) +
geom_point() +
- geom_text(mapping = aes(label = S_escore),
+ geom_text(mapping = aes(label = Média),
nudge_x = 3.5,
size = 4) +
- xlab("Escore final nas sabatinas") +
- ylab("GRR (ordenado pela escore)") +
+ xlab("Nota média") +
+ ylab("GRR (ordenado)") +
# geom_vline(xintercept = c(40, 70),
# linetype = 3,
# lwd = 0.5) +
@@ -235,27 +320,28 @@ ggplot(data = nts,
```
```{r, echo = FALSE, fig.cap = cap, message = FALSE, warning = FALSE, results = "hide"}
-ggplot(data = nts,
+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(nts, cor.test(x = S_escore, y = Faltas, method = "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, echo = FALSE, results = "hide", fig.cap = cap}
+```{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(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) <- nts$GRR
+rownames(X) <- nt$GRR
str(X)
#--------------------------------------------
@@ -330,3 +416,29 @@ bonus. Destas 11 notas, apenas as 6 maiores ($\left\lfloor 0.75 \times 9
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")
+```