notas.Rmd

---
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.

# Lê a tabela com nomes e GRR.
path <- "/home/walmes/Dropbox/Ensino/ce074-2018-02/"
x <- gdata::read.xls(paste0(path, "RelatoriodeDiariodeClasseExcel.xls"),
                     encoding = "latin1",
                     stringsAsFactors = FALSE,
                     skip = 6)
v <- names(x) %in% c("Matrícula", "Nome", "Faltas", "Exame")

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)
# View(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"))
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") %>%
    tolower()

# Junta nomes para formar o nome completo.
nt <- nt %>%
    unite(col = "nome", nome, sobrenome, sep = " ")
str(nt)

# 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)

# Passa notas para escala 0 - 100.
ntg$nota <- ntg$nota * 10

# 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 nota 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.
nt <- ntg %>%
    mutate(nota = round(nota, digits = 2)) %>%
    spread(key = "sabatina", value = "nota")
str(nt)

# Ordena as colunas sabatinas por ordem cronológica.
i <- grep(x = names(nt), pattern = "sabatina")
j <- as.integer(gsub(x = names(nt)[i], pattern = "\\D", replacement = ""))
i[order(j)]
nt[i] <- nt[i[order(j)]]
str(nt)

# Nota das sabatinas mantendo as k maiores notas.
ntg <- ntg %>%
    group_by(nome) %>%
    summarise(S_escore = my_mean(nota, keep = 7, na.rm = TRUE)) %>%
    ungroup()
str(ntg)

# Junção da nota média com as sabatinas.
nt <- nt %>%
    inner_join(ntg)
str(nt)

# Encurta nomes.
names(nt) <- names(nt) %>%
    str_replace("sabatina ", "S")
str(nt)

# Caixa alta nos nomes e arredondamento.
nt <- nt %>%
    mutate(nome = toupper(nome),
           S_escore = ceiling(S_escore))
str(nt)

# View(arrange(nt, S_escore))

#-----------------------------------------------------------------------

# Faz o pareamento dos nomes.
a <- my_match(x = nt$nome, mat$nome)
str(a)

# View(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.
nts <- inner_join(nt, a, by = c("nome" = "template"))

# View(arrange(nts, S_escore) %>% select(nome, GRR, S_escore))
# nts <- edit(nts)

# Nomes que estão sem GRR para preencher manualmente na xlsx.
nts %>%
    filter(is.na(GRR)) %>%
    select(nome) %>%
    print(right = FALSE, row.names = FALSE, print.gap = FALSE)

# # 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))

#-----------------------------------------------------------------------
# Média final.

nt <- nts
nt <- nt %>%
    rename("Média" = "S_escore") %>%
    arrange(GRR)

if (!is.null(nt$Exame)) {
    nt[["M. final"]] <- nt[["Média"]]
    i <- nt[["Média"]] < 70 & nt[["Média"]] >= 40
    u <- nt[["Exame"]]
    u[is.na(u)] <- 0
    nt[["M. final"]][i] <- ceiling((nt[["Média"]][i] + u[i])/2)
}

# View(nt)

#-----------------------------------------------------------------------
# Tabela em HTML.

library(DT)

cap <- "Notas nas avaliações (S: sabatina) ordenadas pelo GRR. Valores entre 0 e 100. Foram consideradas as 7 maiores notas nas sabatinas, de um total de 11, para obtenção do S_escore."
if (require(htmltools)) {
    cap <- HTML("<strong>Tabela 1</strong>:", cap)
}

# i <- c(grep(x = names(nt), "nome"),
#        grep(x = names(nt), "Faltas"),
#        grep(x = names(nt), "M. final"))

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"),
       grep(x = names(nt), "Exame"),
       grep(x = names(nt), "M. final"))

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 <- formatStyle(table = dt,
                  columns = grepl("^(S|Média)", 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")))
}

if (is.element("M. final", names(dt$x$data))) {
    dt <- formatStyle(table = dt,
                      columns = "M. final",
                      color = styleInterval(cuts = c(49.999999),
                                            values = c("#ff3300",
                                                       "#3333ff")))
}

dt
```

```{r, eval = FALSE, 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."

# # Acumulada empírica.
# ggplot(nt, 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("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, fig.cap = cap, message = FALSE, warning = FALSE, results = "hide"}
ggplot(data = nt,
       mapping = aes(y = Média,
                     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 = Média, 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, eval = FALSE, echo = FALSE, results = "hide", fig.cap = cap}
#-----------------------------------------------------------------------
# Análise multivariada das notas.

X <- as.matrix(nt[, grepl("^S\\d", names(nt))])
# rownames(X) <- gsub("^([^ ]+)\\s.*", "\\1", nt$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)
dt
```

<!--
\* 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.
-->