Skip to content

GitLab

ce089
ce089
Commit 4da6663a authored by Walmes Marques Zeviani's avatar Walmes Marques Zeviani
Browse files
Options

Update the grades.

parent 305713a0
Hide whitespace changes
Inline Side-by-side
Showing with 214 additions and 102 deletions
notas.Rmd
View file @ 4da6663a
......@@ -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")
```
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