Inclui as notas.

parent 338a4bb3
......@@ -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/
......
......@@ -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.
-->
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