notas.Rmd 13.2 KB
Newer Older
1 2 3 4 5 6 7 8 9
---
title: Notas das Avaliações
output:
  html_document:
    toc: false
---

```{r, include = FALSE}
#-----------------------------------------------------------------------
10
# Pacotes.
11 12

rm(list = objects())
13
library(tidyverse)
14

15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64
#-----------------------------------------------------------------------
# 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)

65
#-----------------------------------------------------------------------
66 67 68
# Matrícula.

path <- "/home/walmes/Dropbox/Ensino/ce089-2018-02/"
69 70 71 72
x <- gdata::read.xls(paste0(path, "RelatoriodeDiariodeClasseExcel.xls"),
                     encoding = "latin1",
                     stringsAsFactors = FALSE,
                     skip = 6)
73
v <- names(x) %in% c("Matrícula", "Nome", "Faltas", "Exame")
74 75

mat <- x %>%
76
    select(names(x)[v]) %>%
77 78
    filter(grepl("\\d$", Matrícula)) %>%
    as_tibble() %>%
79
    rename("GRR" = "Matrícula", "nome" = "Nome") %>%
80 81
    mutate(GRR = str_replace(GRR, "\\D+", "") %>% as.integer())
str(mat)
82

83 84
#-----------------------------------------------------------------------
# Notas do moodle.
85

86
# Importação.
87 88 89
nt <- read_csv(paste0(path, "notas.csv"),
               locale = locale(decimal_mark = "."),
               na = c("", "-"))
90
attr(nt, "spec") <- NULL
91 92
str(nt)

93
# Seleção de variáveis de nome e notas nas sabatinas.
94
nt <- nt %>%
95 96 97
    select(contains("nome"),
           contains("sabatina"),
           contains("trabalho"))
98
str(nt)
99

100
# Exclui usuários que não são alunos.
101
nt <- nt %>%
102
    filter(!grepl("walmes", Nome, ignore.case = TRUE))
103
str(nt)
104

105 106 107 108 109
# Renomeia variáveis.
names(nt) <- names(nt) %>%
    str_replace(".*(Sabatina.*Q?\\d+).*", "\\1") %>%
    str_replace(".*(Trabalho.*\\d).*", "\\1") %>%
    tolower()
110

111
# Junta nomes para formar o nome completo.
112
nt <- nt %>%
113 114 115 116 117
    unite(col = "nome", nome, sobrenome, sep = " ")
str(nt)

#-----------------------------------------------------------------------
# Tratamento das sabatinas.
118

119
# Empilha nas sabatinas.
120
ntg <- nt %>%
121 122 123 124 125 126
    gather(key = "sabatina",
           value = "nota",
           contains("sabatina"))
if (is.character(ntg$nota)) {
    ntg$nota <- as.numeric(ntg$nota)
}
127 128
str(ntg)

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

132
# Elimina o sulfixo que é da questão na sabatina.
133
ntg <- ntg %>%
134 135
    mutate(sabatina = str_match(sabatina, "sabatina \\d+"),
           nota = replace_na(nota, replace = 0))
136 137
str(ntg)

138 139
# Calcula as notas média por sabatina pro caso de ter mais de uma
# questão.
140
ntg <- ntg %>%
141 142 143 144
    group_by(nome, sabatina) %>%
    summarise(nota = sum(nota, na.rm = TRUE)/n()) %>%
    ungroup()
str(ntg)
145

146 147 148 149 150 151 152 153 154 155 156 157 158
# 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)])
159

160 161 162 163
# Nota das sabatinas mantendo as k maiores notas.
ntg <- ntg %>%
    group_by(nome) %>%
    summarise(S_escore = my_mean(nota, keep = 6, na.rm = TRUE)) %>%
164
    ungroup()
165
str(ntg)
166

167 168 169 170
# Junção da nota média com as sabatinas.
nts <- nts %>%
    inner_join(ntg)
str(nts)
171

172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200
# 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.
201

202 203 204 205 206
ntst <- inner_join(nts, ntt)
ntst

# Caixa alta nos nomes e arredondamento.
ntst <- ntst %>%
207
    mutate(nome = toupper(nome),
208 209 210 211 212 213 214 215 216 217 218
           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
219

220
#-----------------------------------------------------------------------
221 222 223
# Pareamento do GRR para colocar na tabela.

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

227 228 229 230 231 232
# 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.
233 234
nt <- inner_join(nt, a, by = c("nome" = "template"))
str(nt)
235

236 237 238 239 240
# 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)
241

242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258
nt$Média[which(nt$GRR == 20115297)] <- 70

str(nt)

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

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

# View(nt)

259
#-----------------------------------------------------------------------
260
# Tabela em HTML.
261

262
library(DT)
263

264
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."
265 266 267
if (require(htmltools)) {
    cap <- HTML("<strong>Tabela 1</strong>:", cap)
}
268

269 270 271 272
i <- c(grep(x = names(nt), "GRR"),
       grep(x = names(nt), "^S"),
       grep(x = names(nt), "^T"),
       grep(x = names(nt), "Faltas"),
273 274 275
       grep(x = names(nt), "Média"),
       grep(x = names(nt), "Exame"),
       grep(x = names(nt), "M. final"))
276 277

dt <- datatable(data = select(nt, i),
278 279 280 281 282 283 284 285 286 287
                filter = "top",
                caption = cap,
                rownames = FALSE,
                autoHideNavigation = TRUE,
                escape = FALSE,
                options = list(
                    searching = FALSE,
                    paging = FALSE,
                    pageLength = NULL,
                    lengthMenu = NULL))
288
# dt
289

290
dt <- formatStyle(table = dt,
291
                  columns = grepl("^(S|T|Média)", names(dt$x$data)),
292 293 294 295 296
                  color = styleInterval(cuts = c(39.999999,
                                                 69.999999),
                                        values = c("#ff3300",
                                                   "gray",
                                                   "#3333ff")))
297

298 299 300 301 302 303 304 305
if (is.element("Faltas", names(dt$x$data))) {
    dt <- formatStyle(table = dt,
                      columns = "Faltas",
                      color = styleInterval(cuts = c(15),
                                            values = c("#3333ff",
                                                       "#ff3300")))
}

306 307 308 309 310 311 312 313
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")))
}

314 315 316 317
dt
```

```{r, echo = FALSE, fig.cap = cap}
318
#-----------------------------------------------------------------------
319 320
# Visualização.

321
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."
322

323 324
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."

325 326 327 328 329
# # Acumulada empírica.
# ggplot(nts, aes(x = S_escore)) +
#     stat_ecdf() +
#     xlim(0, 100)

330 331 332
ggplot(data = nt,
       mapping = aes(x = Média,
                     color = cut(Média,
333 334
                                 breaks = c(0, 40, 70, 100),
                                 include.lowest = TRUE, right = FALSE),
335
                     y = reorder(GRR, Média))) +
336
    geom_point() +
337
    geom_text(mapping = aes(label = Média),
338 339
              nudge_x = 3.5,
              size = 4) +
340 341
    xlab("Nota média") +
    ylab("GRR (ordenado)") +
342 343 344 345 346 347
    # geom_vline(xintercept = c(40, 70),
    #            linetype = 3,
    #            lwd = 0.5) +
    scale_color_discrete(guide = FALSE) +
    xlim(0, 100)
```
348

349
```{r, echo = FALSE, fig.cap = cap, message = FALSE, warning = FALSE, results = "hide"}
350
ggplot(data = nt,
351 352 353 354 355 356
       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.
357
x <- with(nt, cor.test(x = S_escore, y = Faltas, method = "spearman"))
358 359
x$p.value

360
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)."
361 362 363
cap <- sprintf(cap, x$estimate, x$p.value)
```

364
```{r, include = FALSE, eval = FALSE, echo = FALSE, results = "hide", fig.cap = cap}
365
#-----------------------------------------------------------------------
366
# Análise multivariada das notas.
367

368 369
# X <- as.matrix(nts[, grepl("^S\\d", names(nts))])
X <- as.matrix(nt[, grepl("^(S|T)\\d", names(nt))])
370
# rownames(X) <- gsub("^([^ ]+)\\s.*", "\\1", nts$nome)
371
rownames(X) <- nt$GRR
372
str(X)
373

374 375
#--------------------------------------------
# Componentes principais.
376

377 378
pca <- princomp(x = X)
summary(pca)
379

380
pca$loadings
381

382 383
# screeplot(pca, type = "lines")
# biplot(pca)
384

385 386
#--------------------------------------------
# Agrupamento hierárquico.
387

388
cap <- "**Figura 3**: Agrupamento hierárquico dos GRRs baseado nas distâncias entre os vetores de notas das 10 sabatinas."
389 390 391 392 393 394 395 396 397 398 399

d <- dist(X)
hc <- hclust(d = d)

plot(hc,
     hang = -1,
     cex = 0.8,
     main = NULL,
     sub = "",
     xlab = "GRR",
     ylab = "Similaridade")
400 401 402
```

```{r, eval = FALSE, echo = FALSE, results = "asis"}
403
x <- knitr::kable(nt,
404 405 406 407 408 409 410
                  caption = cap,
                  row.names = FALSE,
                  na.string = "",
                  align = c("c", "c"))
cat(gsub("\\bNA\\b", "--", x), sep = "\n")
```

411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428
<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>

429
```{r, echo = FALSE, results = "asis"}
430
# dt
431

Walmes Marques Zeviani's avatar
Walmes Marques Zeviani committed
432 433
is.decimal <- function(x) is.numeric(x) && !is.integer(x)
formatRound(table = dt,
434
            columns = sapply(dt$x$data, FUN = is.decimal),
Walmes Marques Zeviani's avatar
Walmes Marques Zeviani committed
435
            digits = 1)
436
```
437

438
<!--
439 440
\* 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
441 442 443 444
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.
445
-->
446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471

```{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")
```