AD2 2016.2 - Lab4 - Parte 1
Marianne Linhares
23 de março de 2017
Bibliotecas Utlizadas
Primeiramente vamos importar as bibliotecas necessárias para esse script ser executado.
library(dplyr)
library(reshape2)
library(GGally)
library(ggplot2)
library(corrplot)
library(caret)
library(hydroGOF)Descrição da atividade
Este problema tem por objetivo exercitar os conceitos sobre sistema de recomendação vistos em sala. O cenário de recomendação é o seguinte:
Um aluno (e.g. do quarto período relativo) vai realizar sua matrícula. Nesse momento, o sistema realiza uma predição das notas das disciplinas disponíveis para matrícula desse aluno.
A ideia é usar filtragem colaborativa baseada no usuário para:
- Encontrar os alunos mais similares, em termos de disciplinas cursadas e notas tiradas nessas disciplinas, aos usuários-alvo da recomendação;
- A partir desses vizinhos realizar as predições de notas das disciplinas disponíveis para matrícula.
0. Antes…
0.1 Funções auxiliares e variáveis globais
Para preparar e transformar os dados foram usadas as funções e variáveis auxiliares apresentadas nesta seção.
COL_DADOS = c("matricula", "ano", "periodo", "AL", "AV", "C1", "C2", "ES", "EDA",
"FC", "FM", "GI", "IC", "LEDA", "LOAC", "LP1", "LP2", "LPT", "LM",
"MD", "ME", "OAC", "PLP", "PE", "P1", "P2", "SI1", "TC", "TG")
COL_QUARTO_PER = c("EDA", "GI", "LEDA", "ME", "PE", "PLP", "TC")
# -------------------- Collaborative Filtering -------------------------------
K = 10
NEIGH = 0.7
# retorna uma matriz de correlação usando cor. de pearson
get_sim <- function(df) {
row.names(df) <- df$matricula
df <- df %>% subset(select=-c(matricula))
inv_df <- as.data.frame(t(df))
res <- cor(inv_df[sapply(inv_df, is.numeric)], use="p", method='pearson')
return(res);
}
# retorna um vector de Named num, cujo nome é a matrícula e o valor a similaridade
get_neigh <- function(df, index, corr) {
matr <- as.character(df[index, 1])
# todos os vizinhos, porém temos que "invalidar" ele mesmo
corr[matr, matr] = 0
all_neigh <- corr[matr, ]
k_neigh <- sort(all_neigh, decreasing = T)[1:K]
return(k_neigh);
}
# calcula score ignorando vizinhos com NAs
get_score <- function(df, k_neigh, item) {
notas <- subset(df, matricula %in% names(k_neigh))
# removendo vizinhos que não possuem notas
notas <- na.omit(notas)
# se todas as notas dos vizinhos forem NAs ou nenhum vizinho com
# nota tenha similaridade > NEIGH consideramos que esse aluno
# não tem vizinhos
if(nrow(notas) == 0) {
return(NA)
}
# atualizando similaridade
notas$sim <- 0
for(i in 1:length(notas$matricula)) {
notas$sim[i] <- k_neigh[as.character(notas$matricula[i])]
}
# se todas as notas dos vizinhos forem NAs ou nenhum vizinho com
# nota tenha similaridade > NEIGH consideramos que esse aluno
# não tem vizinhos
eh_valido <- notas[notas$sim > NEIGH,]
if(nrow(eh_valido) == 0) {
return(NA)
}
# print(item)
# print(notas[, item])
# print(sum(notas[, item] * notas$sim) / sum(notas$sim))
res <- sum(notas[, item] * notas$sim) / sum(notas$sim)
return(res)
}1. Recebendo e preparando os dados
Para preparação dos dados foi tomada a seguinte decisão: 5% dos dados serão escolhidos como dados de teste e portanto os valores das suas notas originais foram salvas para serem comparadas com a predição.
# recebe dados
dados <- read.csv('~/DataAnalysis2/lab4/data.csv')
# remove NAs
# dados <- na.omit(dados)
# renomeando colunas
colnames(dados) <- COL_DADOS
# separando em teste e treino
temp <- createDataPartition(dados$ano, p = 0.95, list = F)
# removendo colunas de ano e período
dados <- dados %>% subset(select=-c(ano, periodo))
# os dados de teste são zerados, copiados para uma nova tabela
# zerando
teste <- dados
for(i in 1:length(COL_QUARTO_PER)) {
teste[-temp,][COL_QUARTO_PER[i]] <- NA;
}
# copiando
teste_valores <- teste[-temp, ]
teste_indices <- rownames(teste_valores)2. Realizando predição
Nesta seção serão realizadas as seguintes atividades:
Encontrar os alunos mais similares, em termos de disciplinas cursadas e notas tiradas nessas disciplinas, aos usuários-alvo da recomendação;
A partir desses vizinhos realizar as predições de notas das disciplinas que os usuários-alvo se matricularam.
Utilizei K = 10 (Segundo o professor K = 5 ou K = 10 geralmente são bons valores) e considerei que os vizinhos não são “válidos” caso nenhum dos vizinhos com notas disponíveis apresentem similaridade > 0.7. Para indicar a não existência da predição foi utilizado NA.
# calcula a similaridade entre todos os alunos (de todos para todos)
corr <- teste %>% get_sim()## Warning in cor(inv_df[sapply(inv_df, is.numeric)], use = "p", method =
## "pearson"): the standard deviation is zero# calcula predição: média ponderada dos K vizinhos mais próximos
for(i in 1:length(teste_indices)) {
index <- teste_indices[i]
k_proximos <- get_neigh(teste, index, corr)
for(j in 1:length(COL_QUARTO_PER)) {
pred <- get_score(teste[, c("matricula", COL_QUARTO_PER[j])],
k_proximos, COL_QUARTO_PER[j])
teste_valores[index, COL_QUARTO_PER[j]] <- pred
}
}
# simplificando os dados
dados_reais <- dados[-temp, COL_QUARTO_PER]
predicao <- teste_valores[, COL_QUARTO_PER]2.1 Porcentagem dos exemplos de teste sem predição
Para indicar a ausência de predição foi colocado o valor de NA na disciplina, segue abaixo a análise do número de exemplos sem predição.
# número de elementos em cada coluna de teste = 56
total_alunos <- sapply(predicao, function(x) length(x))
# número de NA em cada coluna, ou seja número de alunos sem predição por disciplina
sem_predicao <- sapply(predicao, function(x) sum(is.na(x)))
# porcentagem de alunos sem predição por disciplina
(sem_predicao/total_alunos) * 100## EDA GI LEDA ME PE PLP TC
## 3.571429 0.000000 3.571429 19.642857 10.714286 17.857143 1.785714# porcentagem total de variáveis sem predição
(sum(sem_predicao)/sum(total_alunos)) * 100## [1] 8.163265Portanto, apenas ~8% das variáveis de teste (total de 56 alunos) não obtiveram uma predição por falta de vizinhos próximos o suficiente ou muitos valores NAs.
Sendo que destes grande parte ficou concentrado na disciplina de Métodos estatísticos, Paradigmas de linguagens de programação e Probabilidade e Estatística, provavelmente devido ao grande número de NAs nessas disciplinas, para comprovar essa hipótese segue abaixo o número de NAs nas disciplinas nos dados de teste.
sapply(teste, function(x) sum(is.na(x)))## matricula AL AV C1 C2 ES EDA
## 0 517 62 73 553 400 188
## FC FM GI IC LEDA LOAC LP1
## 205 292 127 33 200 382 21
## LP2 LPT LM MD ME OAC PLP
## 58 72 284 110 484 377 329
## PE P1 P2 SI1 TC TG
## 347 21 56 221 206 54De fato, ME, PE e PLP são disciplinas que apresentam um grande número de NAs, e se destacam como as disciplinas com mais NAs no quarto período.
2.2 Comparando predição com dados reais
Para isso irei calcular o RMSE entre os dados reais e a predição. Utilizei o pacote hydroGOF que contém uma função para calcular rmse entre dois data frames.
rmse(sim=predicao, obs=dados_reais)## EDA GI LEDA ME PE PLP TC
## 2.585149 1.263001 2.334676 2.271330 1.825156 1.229513 1.621955O RMSE acima parece ser razoável para as disciplinas de GI, PLP e TC. O RMSE para estas disciplinas indica que nossas predições são em média ~1.2 (~1.6 para TC) acima ou abaixo os valores reais presente nas notas dos alunos, já as demais disciplinas tem média próxima de 2, que acho um resultado expressivo dada a simplicidade do modelo.
for (i in 1:length(COL_QUARTO_PER)) {
plot(predicao[, COL_QUARTO_PER[i]],
dados_reais[, COL_QUARTO_PER[i]],
xlab=paste("predicao ", COL_QUARTO_PER[i]),
ylab=paste("dado real", COL_QUARTO_PER[i]))
abline(lm(predicao[, COL_QUARTO_PER[i]]~dados_reais[, COL_QUARTO_PER[i]]), col="red")
# regression line (y~x)
}
