LR vs CF - Predição de Notas
Lívia Cavalcanti
21 de dezembro de 2017
O objetivo do código atual é obter uma predição de notas do quarto período feita a partir de Regressão Linear e compará-la com os resultados obtidos por Filtragem Colaborativa.
Bibliotecas Utilizadas
library(dplyr)
library(corrplot)
library(GGally)
library(ggplot2)
library(reshape2)
library(caret)
library(mlbench)
library(grid)Os dados
O tratamento dos dados é o mesmo feito nesta análise de Collaborative Filtering, isso porque o objetivo atual é trabalhar com matrizes completas de modo a facilitar a avaliação da predição, por exemplo. Aqui a predição a ser feita é para as notas dos alunos de Ciência da Computação da Universidade Federal de Campina Grande em disciplinas do quarto período.
dados_alunos <- read.csv("../alunosUFCGAnon.csv")
dados_aluno_cc <- dados_alunos %>% filter(Cod_Curso == 14102100 & Cod_Evasao == 0 & Tipo == "Obrigatória")
dados_aluno_cc <- dados_aluno_cc %>% mutate(Matricula = factor(Matricula)) %>% arrange(Matricula) %>%
select(Matricula, Cod_Disciplina, Nome_Disciplina, Periodo, Creditos, Media_Disciplina, Situacao, Periodo_Ingresso, Periodo_Relativo)
dados_aluno_cc <- dados_aluno_cc %>% group_by(Matricula) %>% mutate(Media = round(mean(Media_Disciplina), digits = 2)) %>% filter(!is.na(Media))
# storing data as factors insures that the modeling functions will treat such data correctly.
# Factors in R are stored as a vector of integer values with a corresponding set of character values to use when the factor is displayed
# Calulo do CRA
alunos_cra <- dados_aluno_cc %>% mutate(Cra.Crontibute = Media*Creditos) %>% summarise(cra = sum(Cra.Crontibute)/sum(Creditos))
alunos_max_media <- dados_aluno_cc %>% group_by(Matricula, Media_Disciplina) %>% filter(Media_Disciplina == max(Media_Disciplina)) %>% ungroup() %>%
select(Nome_Disciplina, Matricula, Media_Disciplina) %>% mutate(Nome_Disciplina = as.factor(gsub(" ", ".", Nome_Disciplina))) %>%
dcast(Matricula ~ Nome_Disciplina, mean) %>% merge(alunos_cra)## Using Media_Disciplina as value column: use value.var to override.alunos_max_media <- bind_cols(alunos_max_media,distinct(dados_aluno_cc %>% select(Matricula, Periodo_Ingresso))%>% select(Periodo_Ingresso)) %>% select(-Matricula1)## Adding missing grouping variables: `Matricula`alunos_graduados <- alunos_max_media[complete.cases(alunos_max_media), ]
##Organizando os data frames principais
# separando alunos por periodo
primeiro_periodo <- alunos_max_media %>% select(Matricula, cra, CALCULO.DIFERENCIAL.E.INTEGRAL.I, ÁLGEBRA.VETORIAL.E.GEOMETRIA.ANALÍTICA, PROGRAMAÇÃO.I,
LABORATÓRIO.DE.PROGRAMAÇÃO.I, INTRODUÇÃO.A.COMPUTAÇÃO, LEITURA.E.PRODUCAO.DE.TEXTOS, Periodo_Ingresso) %>%
na.omit(primeiro_periodo) %>% arrange(Matricula) %>%
rename(matricula = Matricula, cra = cra,calculo1 = CALCULO.DIFERENCIAL.E.INTEGRAL.I, vetorial = ÁLGEBRA.VETORIAL.E.GEOMETRIA.ANALÍTICA, p1 = PROGRAMAÇÃO.I,
lp1 = LABORATÓRIO.DE.PROGRAMAÇÃO.I, ic = INTRODUÇÃO.A.COMPUTAÇÃO, lpt = LEITURA.E.PRODUCAO.DE.TEXTOS)
head(primeiro_periodo)## matricula cra calculo1 vetorial p1 lp1 ic lpt Periodo_Ingresso
## 1 B10079 6.37 5.75 5.00 5.0 5.75 7.10 9.5 2007.1
## 2 B10087 1.05 0.00 0.00 0.0 0.00 1.95 7.6 2008.2
## 3 B10088 2.10 0.00 0.15 0.7 0.00 5.20 7.7 2009.2
## 4 B10092 7.10 6.90 4.25 5.0 7.00 7.50 8.5 2009.1
## 5 B10172 4.68 2.70 5.35 6.9 7.10 7.30 8.2 2011.2
## 6 B10192 6.55 5.85 5.00 8.4 8.40 7.80 8.8 2006.1segundo_periodo <- alunos_max_media %>%
select(Matricula,cra, CALCULO.DIFERENCIAL.E.INTEGRAL.II, FUNDAMENTOS.DE.FÍSICA.CLÁSSICA, TEORIA.DOS.GRAFOS, PROGRAMAÇÃO.II,
LABORATÓRIO.DE.PROGRAMAÇÃO.II, MATEMÁTICA.DISCRETA) %>% na.omit() %>%
arrange(Matricula) %>%
rename(matricula = Matricula, cra = cra,calculo2 = CALCULO.DIFERENCIAL.E.INTEGRAL.II, classica = FUNDAMENTOS.DE.FÍSICA.CLÁSSICA,
grafos = TEORIA.DOS.GRAFOS, p2 = PROGRAMAÇÃO.II, lp2 = LABORATÓRIO.DE.PROGRAMAÇÃO.II, discreta = MATEMÁTICA.DISCRETA)
head(segundo_periodo)## matricula cra calculo2 classica grafos p2 lp2 discreta
## 1 B10079 6.37 4.200000 5.7 7.8 8.90 8.3 4.050000
## 2 B10092 7.10 5.400000 5.0 5.1 6.70 8.2 5.000000
## 3 B10172 4.68 2.033333 5.5 5.5 4.15 3.0 4.666667
## 4 B10192 6.55 5.400000 6.4 5.0 6.00 8.2 5.000000
## 5 B10199 5.86 5.100000 7.8 5.0 6.30 8.7 5.100000
## 6 B1024 5.91 5.000000 5.3 7.6 8.30 8.7 7.000000terceiro_periodo <- alunos_max_media %>%
select(Matricula,cra, ESTRUTURA.DE.DADOS.E.ALGORITMOS, LAB.DE.ESTRUTURA.DE.DADOS.E.ALGORITMOS, FUNDAMENTOS.DE.FÍSICA.MODERNA,
ALGEBRA.LINEAR.I,PROBABILIDADE.E.ESTATISTICA, TEORIA.DA.COMPUTAÇÃO, GERÊNCIA.DA.INFORMAÇÃO) %>%
na.omit() %>%
arrange(Matricula) %>%
rename(matricula = Matricula, eda = ESTRUTURA.DE.DADOS.E.ALGORITMOS, leda = LAB.DE.ESTRUTURA.DE.DADOS.E.ALGORITMOS, moderna = FUNDAMENTOS.DE.FÍSICA.MODERNA,
linear = ALGEBRA.LINEAR.I, prob = PROBABILIDADE.E.ESTATISTICA, tc = TEORIA.DA.COMPUTAÇÃO, gi = GERÊNCIA.DA.INFORMAÇÃO)
head(terceiro_periodo)## matricula cra eda leda moderna linear prob tc gi
## 1 B10092 7.10 6.60 7.9 8.3 6.1 6.0 7.2 7.7
## 2 B10284 7.14 7.00 7.2 8.3 6.1 5.5 6.9 7.0
## 3 B10304 6.17 5.15 7.0 8.5 6.2 1.2 6.9 8.6
## 4 B10443 7.15 7.00 7.7 8.7 7.2 6.8 7.3 7.9
## 5 B10504 7.12 6.70 8.2 8.3 5.0 6.7 7.0 7.1
## 6 B10644 6.07 5.10 5.2 5.0 5.1 5.0 5.3 4.7quarto_periodo <- alunos_max_media %>% select(Matricula, cra, PARADIGMAS.DE.LING..DE.PROGRAMAÇÃO, METODOS.ESTATISTICOS, ORG.E.ARQUITETURA.DE.COMPUTADORES.I,
LAB.DE.ORG.E.ARQUITETURA.DE.COMPUTADORES, LÓGICA.MATEMÁTICA, ENGENHARIA.DE.SOFTWARE.I, SISTEMAS.DE.INFORMAÇÃO.I) %>%
na.omit() %>%
arrange(Matricula)%>%
rename(matricula = Matricula, plp = PARADIGMAS.DE.LING..DE.PROGRAMAÇÃO, metodos = METODOS.ESTATISTICOS, oac = ORG.E.ARQUITETURA.DE.COMPUTADORES.I,
loac = LAB.DE.ORG.E.ARQUITETURA.DE.COMPUTADORES, logica = LÓGICA.MATEMÁTICA, es = ENGENHARIA.DE.SOFTWARE.I, si1 = SISTEMAS.DE.INFORMAÇÃO.I)
head(quarto_periodo)## matricula cra plp metodos oac loac logica es si1
## 1 B10092 7.10 7.0 5.0 7.6 7.1 7.0 6.6 9.3
## 2 B10192 6.55 7.3 5.1 5.8 7.3 6.6 6.3 9.6
## 3 B10199 5.86 5.6 6.5 5.2 8.6 6.2 7.0 5.7
## 4 B10447 8.66 8.1 8.7 8.3 9.2 10.0 9.2 9.6
## 5 B10504 7.12 9.3 6.0 7.2 9.6 8.3 8.1 9.7
## 6 B10644 6.07 5.5 6.4 7.3 8.7 7.0 8.3 8.4# Unindo os periodos
primeiro_segundo_periodos <- merge(primeiro_periodo, segundo_periodo)
head(primeiro_segundo_periodos)## matricula cra calculo1 vetorial p1 lp1 ic lpt Periodo_Ingresso
## 1 B10079 6.37 5.750000 5.00 5.0 5.75 7.1 9.5 2007.1
## 2 B10092 7.10 6.900000 4.25 5.0 7.00 7.5 8.5 2009.1
## 3 B10172 4.68 2.700000 5.35 6.9 7.10 7.3 8.2 2011.2
## 4 B10192 6.55 5.850000 5.00 8.4 8.40 7.8 8.8 2006.1
## 5 B10199 5.86 3.666667 6.20 6.1 5.60 7.8 7.0 2005.2
## 6 B1024 5.91 0.000000 5.45 7.5 8.40 7.7 7.0 2010.1
## calculo2 classica grafos p2 lp2 discreta
## 1 4.200000 5.7 7.8 8.90 8.3 4.050000
## 2 5.400000 5.0 5.1 6.70 8.2 5.000000
## 3 2.033333 5.5 5.5 4.15 3.0 4.666667
## 4 5.400000 6.4 5.0 6.00 8.2 5.000000
## 5 5.100000 7.8 5.0 6.30 8.7 5.100000
## 6 5.000000 5.3 7.6 8.30 8.7 7.000000# Primeiro, segundo e terceiro periodo
primeiro_a_terceiro_periodo <- merge(primeiro_segundo_periodos, terceiro_periodo)
periodos_dados <- merge(primeiro_a_terceiro_periodo, quarto_periodo) %>% select(matricula, everything())
head(periodos_dados)## matricula cra calculo1 vetorial p1 lp1 ic lpt Periodo_Ingresso
## 1 B10092 7.10 6.90 4.25 5.0 7.0 7.5 8.5 2009.1
## 2 B10504 7.12 4.65 6.30 5.3 7.9 7.6 7.2 2009.1
## 3 B10644 6.07 3.70 5.80 7.0 7.2 8.3 7.2 2010.2
## 4 B10973 6.73 5.60 5.60 7.0 7.7 8.4 6.7 2010.1
## 5 B11044 8.47 8.70 8.60 9.0 8.6 9.1 10.0 2008.1
## 6 B11365 8.35 6.20 8.20 7.9 7.9 9.2 9.3 2010.2
## calculo2 classica grafos p2 lp2 discreta eda leda moderna linear prob
## 1 5.400000 5.000000 5.1 6.7 8.2 5.0 6.6 7.9 8.3 6.1 6.0
## 2 5.000000 5.750000 6.3 7.7 5.0 6.3 6.7 8.2 8.3 5.0 6.7
## 3 4.033333 3.266667 7.9 7.6 7.0 6.5 5.1 5.2 5.0 5.1 5.0
## 4 5.900000 7.400000 5.9 7.4 7.0 6.8 7.0 5.0 7.7 6.7 5.2
## 5 8.400000 7.900000 8.2 8.8 9.4 8.3 8.4 9.4 9.4 9.3 7.2
## 6 6.900000 6.900000 9.2 9.1 9.3 7.6 7.1 8.6 8.2 8.3 7.0
## tc gi plp metodos oac loac logica es si1
## 1 7.2 7.7 7.0 5.0 7.6 7.1 7.0 6.60 9.3
## 2 7.0 7.1 9.3 6.0 7.2 9.6 8.3 8.10 9.7
## 3 5.3 4.7 5.5 6.4 7.3 8.7 7.0 8.30 8.4
## 4 7.6 7.7 7.0 8.6 6.6 5.0 5.8 4.75 8.4
## 5 7.8 7.8 6.8 9.0 8.2 8.8 10.0 8.50 8.4
## 6 7.9 7.7 9.4 8.1 8.2 10.0 8.4 9.10 9.4São separados 95% dos dados para treino e guardados seus valores para posterior análise de erro, que devem ser logo em seguidas escondidos no data frame utilizado para predição a fim de que não haja enviesamento da mesma. A matrícula foi transformada em uma sequência numéria mais fácil de ser manipulada.
## Divindo em arquivo de teste e treino
COL_QUARTO_PER <- colnames(quarto_periodo %>% select(-cra, -matricula))
temp <- createDataPartition(periodos_dados$Periodo_Ingresso, p = 0.95, list = F)
# os dados de teste são zerados, copiados para uma nova tabela
# zerando
teste <- periodos_dados
resultados_geral <-teste[-temp,]
resultados <-teste[-temp, COL_QUARTO_PER]
resultados## plp metodos oac loac logica es si1
## 19 7.20 7.20 7.5 8.3 7.5 8.7 8.3
## 24 5.00 5.40 7.3 7.9 6.8 5.8 8.2
## 27 6.75 4.05 8.3 9.3 7.6 7.0 6.9
## 105 7.00 8.10 7.3 8.3 7.0 8.4 8.0
## 118 8.50 8.10 7.9 8.9 9.2 8.8 9.6for(i in 1:length(COL_QUARTO_PER)) {
teste[-temp,][COL_QUARTO_PER[i]] <- NA
}
# atribuindo valores numeros as matriculas
teste <- teste %>% bind_cols(matricula_2 = c(1:121)) %>% select(-matricula) %>% select(matricula_2, everything()) %>% rename(matricula = matricula_2)
head(teste)## matricula cra calculo1 vetorial p1 lp1 ic lpt Periodo_Ingresso
## 1 1 7.10 6.90 4.25 5.0 7.0 7.5 8.5 2009.1
## 2 2 7.12 4.65 6.30 5.3 7.9 7.6 7.2 2009.1
## 3 3 6.07 3.70 5.80 7.0 7.2 8.3 7.2 2010.2
## 4 4 6.73 5.60 5.60 7.0 7.7 8.4 6.7 2010.1
## 5 5 8.47 8.70 8.60 9.0 8.6 9.1 10.0 2008.1
## 6 6 8.35 6.20 8.20 7.9 7.9 9.2 9.3 2010.2
## calculo2 classica grafos p2 lp2 discreta eda leda moderna linear prob
## 1 5.400000 5.000000 5.1 6.7 8.2 5.0 6.6 7.9 8.3 6.1 6.0
## 2 5.000000 5.750000 6.3 7.7 5.0 6.3 6.7 8.2 8.3 5.0 6.7
## 3 4.033333 3.266667 7.9 7.6 7.0 6.5 5.1 5.2 5.0 5.1 5.0
## 4 5.900000 7.400000 5.9 7.4 7.0 6.8 7.0 5.0 7.7 6.7 5.2
## 5 8.400000 7.900000 8.2 8.8 9.4 8.3 8.4 9.4 9.4 9.3 7.2
## 6 6.900000 6.900000 9.2 9.1 9.3 7.6 7.1 8.6 8.2 8.3 7.0
## tc gi plp metodos oac loac logica es si1
## 1 7.2 7.7 7.0 5.0 7.6 7.1 7.0 6.60 9.3
## 2 7.0 7.1 9.3 6.0 7.2 9.6 8.3 8.10 9.7
## 3 5.3 4.7 5.5 6.4 7.3 8.7 7.0 8.30 8.4
## 4 7.6 7.7 7.0 8.6 6.6 5.0 5.8 4.75 8.4
## 5 7.8 7.8 6.8 9.0 8.2 8.8 10.0 8.50 8.4
## 6 7.9 7.7 9.4 8.1 8.2 10.0 8.4 9.10 9.4# copiando
teste_valores <- teste[-temp, ]
teste_valores## matricula cra calculo1 vetorial p1 lp1 ic lpt Periodo_Ingresso
## 19 19 7.55 5.25 7.3 7.9 7.8 7.7 7.6 2009.2
## 24 24 5.67 5.20 5.7 2.7 2.9 7.5 7.7 2006.2
## 27 27 7.68 7.80 9.7 9.1 8.8 9.8 7.3 2008.2
## 105 105 6.53 4.60 5.5 7.0 7.1 8.1 7.5 2011.1
## 118 118 8.04 6.10 7.6 8.0 7.6 8.8 9.8 2008.1
## calculo2 classica grafos p2 lp2 discreta eda leda moderna linear
## 19 6.10 7.5 7.6 7.8 9.00 7.00 7.2 8.60 9.7 7.2
## 24 3.75 7.0 5.3 7.0 8.90 3.65 2.5 3.25 7.7 5.7
## 27 8.00 7.5 8.9 9.0 9.10 7.60 7.8 9.30 7.5 7.0
## 105 4.50 4.4 6.2 5.7 5.05 5.90 6.1 6.30 7.3 5.0
## 118 5.00 7.3 7.4 8.8 9.20 7.00 6.0 7.80 8.0 6.8
## prob tc gi plp metodos oac loac logica es si1
## 19 5.10 7.50 7.1 NA NA NA NA NA NA NA
## 24 3.95 4.40 7.3 NA NA NA NA NA NA NA
## 27 4.05 8.90 8.6 NA NA NA NA NA NA NA
## 105 5.00 7.70 5.2 NA NA NA NA NA NA NA
## 118 6.10 6.55 8.4 NA NA NA NA NA NA NAteste_indices <- rownames(teste_valores)Predição
A predição é feita com base na correção entre as cadeiras
corr_cadeiras <- (periodos_dados %>% select(-matricula, -Periodo_Ingresso) %>% cor())
corrplot(corr_cadeiras)
corr_cadeiras <- as.data.frame(corr_cadeiras)Em seguida, considera-se as 10 cadeiras mais semelhantes para cada disciplina do quarto período e controi-se um modelo de Regresão Linear. Que está exemplificado abaixo pela disciplina Organização e Arquitetura de Computadores(OAC). São consideradas doze disciplinas nesse caso, pois a cadeira é semelhante a ela mesma e ao seu respectivo laboratório(Laboratório de Organização e Arquitetura de Computadores - LOAC) que devem ser cursadas simultanemente e devem portanto, serem descartadas para o cálculo do modelo de predição. A mesma lógica segue para as disciplinas do quarto período, a saber: Métodos Estatísticos, Paradigmas de Linguagem de Programação, Lógica Matemática, Engenharia de Software I, Sistemas de Informação I e Laboratório de Organização e Arquitetura de Computadores).
# fazendo predicao para cada cadeira do quarto periodo
# oac
analise_oac <- corr_cadeiras %>% select(oac)
ranking_oac <- cbind(analise_oac, as.data.frame(rownames(analise_oac)))
ranking_oac <- top_n(ranking_oac, 12,oac) %>% rename(cadeiras = "rownames(analise_oac)")
ranking_oac %>% select(cadeiras)## cadeiras
## 1 cra
## 2 ic
## 3 p2
## 4 discreta
## 5 linear
## 6 prob
## 7 metodos
## 8 oac
## 9 loac
## 10 logica
## 11 es
## 12 si1modelo_oac <- lm(oac ~ cra + ic + p2 + discreta + linear + prob + metodos + logica + es + si1, data = teste)
summary(modelo_oac)##
## Call:
## lm(formula = oac ~ cra + ic + p2 + discreta + linear + prob +
## metodos + logica + es + si1, data = teste)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.96008 -0.49834 0.00693 0.48488 1.92460
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.644730 0.796437 2.065 0.041376 *
## cra 1.158142 0.294997 3.926 0.000155 ***
## ic -0.099129 0.111175 -0.892 0.374619
## p2 -0.168654 0.123735 -1.363 0.175788
## discreta 0.036573 0.078421 0.466 0.641920
## linear 0.067952 0.084502 0.804 0.423128
## prob -0.226434 0.088398 -2.562 0.011841 *
## metodos 0.008845 0.066050 0.134 0.893726
## logica 0.068728 0.094377 0.728 0.468100
## es -0.027524 0.077971 -0.353 0.724798
## si1 -0.006861 0.100281 -0.068 0.945581
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.8763 on 105 degrees of freedom
## (5 observations deleted due to missingness)
## Multiple R-squared: 0.5306, Adjusted R-squared: 0.4859
## F-statistic: 11.87 on 10 and 105 DF, p-value: 1.847e-13plot(modelo_oac, which = 1:2)
A predicação é feita selecionando-se as notas das cadeiras com maior correlação com a disciplina em questão e fazendo a predição com o modelo previamente obtido para os dados de teste. A seguir temos um exemplo do que é feito para as demais disciplinas do período.
# predição
RMSE <- function(predicted, true) mean((predicted-true)^2)^.5
#oac
teste_oac <- resultados_geral %>% select(-matricula, -Periodo_Ingresso, -calculo1, -vetorial, -p1, -lp1, -lpt, -calculo2, -classica, -grafos, -lp2, -eda, -leda, -moderna, -tc, -gi, -plp, -oac)
teste_oac## cra ic p2 discreta linear prob metodos loac logica es si1
## 19 7.55 7.7 7.8 7.00 7.2 5.10 7.20 8.3 7.5 8.7 8.3
## 24 5.67 7.5 7.0 3.65 5.7 3.95 5.40 7.9 6.8 5.8 8.2
## 27 7.68 9.8 9.0 7.60 7.0 4.05 4.05 9.3 7.6 7.0 6.9
## 105 6.53 8.1 5.7 5.90 5.0 5.00 8.10 8.3 7.0 8.4 8.0
## 118 8.04 8.8 8.8 7.00 6.8 6.10 8.10 8.9 9.2 8.8 9.6resultados$oac## [1] 7.5 7.3 8.3 7.3 7.9predict(modelo_oac, teste_oac)## 19 24 27 105 118
## 8.183094 6.212962 8.204611 7.133142 8.332398RMSE(predict(modelo_oac, teste_oac), resultados$oac)## [1] 0.6119116Em seguida, comparou-se os resultados obtidos com as predições através dos métodos de Filtragem Colaborativa e Regressão Linear.
df %>% ggplot(aes(disciplinas, media_rmse,color = tipo)) + geom_point( show.legend = T)
Testando-se várias vezes, percebe-se que a análise de melhor método depende da amostra considerada.