library(readxl) dados <- read_excel("C:/Users/moura/Downloads/AnaliseAD2.xlsx") X <- dados[, c("APTOTAL", "AP1", "AP2", "AP3", "P", "SAEBM", "SAEBLP", "IDEB")] grupo <- as.factor(dados$GRE) library(MASS) library(scatterplot3d) # Cores para os grupos cores <- rainbow(length(levels(grupo))) # Gráfico 3D scatterplot3d( dados$SAEBM, dados$SAEBLP, dados$IDEB, color = cores[grupo], pch = 19, main = "Distribuição 3D das GREs", xlab = "SAEB Matemática", ylab = "SAEB Língua Portuguesa", zlab = "IDEB" ) legend("topleft", legend = levels(grupo), col = cores, pch = 19, bty = "n") library(tidyverse) ; library(gridExtra) dados %>% dplyr::select(SAEBLP, SAEBM, IDEB, APTOTAL) %>% GGally::ggpairs(aes(color = grupo)) + scale_colour_manual(values = c("darkorange", "purple", "cyan4")) + scale_fill_manual(values = c("darkorange", "purple", "cyan4")) + theme_bw() # Execução da função m1 <- lda(X, grupo, CV = TRUE) summary(m1) # Segundo modelo (ressubstituiçãoo) m2 <- lda(grupo ~ SAEBLP+SAEBM+IDEB+APTOTAL,data = X) # Matriz de confus?o (ressubstitui??o) m2class <- predict(m2, X)$class tabela2 <- xtabs(~ m2class + grupo, data = X) cat("\n Matriz de confusão (com ressubstituição):") tabela2 cat("\n Acerto (%) = \n", levels(grupo), "\n", diag(tabela2) / colSums(tabela2) * 100) cat("\n Acerto global (%) =", sum(diag(tabela2)) /24 *100) cat("\n Funções discriminantes: \n") coef(m2) cat("\n Razão dos desvios padrão entre e intragrupos para cada FD =") m2$svd # Escores das observações FD <- as.matrix(dados[, c("APTOTAL", "SAEBM", "SAEBLP", "IDEB")]) %*% coef(m2) dim(FD) # Centroides dos grupos e escores dos centróides m2$means (FDb <- m2$means %*% coef(m2)) # Gráfico de pontos de FD1 stripchart(FD[, 1] ~ grupo, pch = 20, xlab = "Função discriminante 1", ylab = "Grupos",col = c("black","blue","red"), method = "stack", data = X) points(FDb[, 1], (1:length(m2$lev)) + 0.05, pch = 13, col = c("black","blue","red"), cex = 1.5) # Histograma de FD1 ldahist(FD[, 1], grupo) # Histograma de FD2 ldahist(FD[, 2], grupo, col = "red") # Gráfico de dispersão de FD1 e FD2 plot(FD[, 1], FD[, 2], pch = 20, col = rep(c(1,2,3),each=50), xlab = "Função discriminante 1", ylab = "Função discriminante 2") points(FDb[, 1], FDb[, 2], pch = 13, col = 1:3, cex = 1.5) text(FDb[, 1], FDb[, 2], m2$lev) # Médias por grupos aggregate(dados[, c("APTOTAL", "SAEBM", "SAEBLP", "IDEB")], list(grupo), mean) aggregate(dados[, c("APTOTAL", "SAEBM", "SAEBLP", "IDEB")], list(grupo), sd) par(mar=c(4,4,1,1)) plot(m2) ## Uma ótica mais IA library(tidyverse) library(caret) library(MASS) # Particionando os dados em treinamento (80%) e teste (20%) set.seed(123) treino = dados$GRE %>% createDataPartition(p = 0.8, list = FALSE) dtreino = dados[treino, ] dteste = dados[-treino, ] # Estimate preprocessing parameters preproc = dtreino %>% preProcess(method = c("center", "scale")) # Transforando os dados usando os parâmetros estimados dtreino2 = preproc %>% predict(dtreino) dteste2 = preproc %>% predict(dteste) # aplicando a análise discriminante m22 <- lda(dtreino2$GRE~., data = dtreino2) # Obtendo as predições pred <- m22 %>% predict(dteste2) # Matriz de confusão tcL = table(dteste2$GRE, pred$class) dimnames(tcL) <- list(Observados = c("15ª GRE", "18ª GRE","5ª GRE"), "Predictos (cv)" = c("15ª GRE", "18ª GRE","5ª GRE")) print(round(tcL)) sum(diag(prop.table(tcL))) # Acurácia da aplicação mean(pred$class==dteste2$GRE) # Saída! m22 plot(m22) names(pred) # Classes preditas pred$class # Probabilidades preditas de associação à classe pred$posterior # Discriminantes lineares pred$x lda.data = cbind(dtreino2, predict(m22)$x) ggplot(lda.data, aes(LD1, LD2)) + geom_point(aes(color = GRE)) + theme(legend.position = "bottom") ggplot(lda.data, aes(LD1, LD2, color = GRE)) + geom_point() + theme(legend.position = c(0.6, 0.05), # x, y (0,0 é o canto inferior esquerdo) legend.justification = c(0.5, 0.05)) library(MASS) install.packages("MLmetrics") library(MLmetrics) help = ifelse(dteste2[,1] == "15ª GRE",1,0) Accuracy(pred$posterior[,1],help) library(mda) # install.packages("mda") # Discriminante via misturas m24 = mda(GRE~., data = dtreino2) ; m24 # Predições pred3 = m24 %>% predict(dteste2) # Matriz de confusão tcM = table(dteste2$GRE, pred3) dimnames(tcM) <- list(Observados = c("15ª GRE", "18ª GRE","5ª GRE"), "Predictos (cv)" = c("15ª GRE", "18ª GRE","5ª GRE")) print(round(tcM)) sum(diag(prop.table(tcM))) # Model accuracy mean(pred3 == dteste2$GRE) # Gráfico exploratório da LDA ou QDA install.packages("klaR") library(klaR) partimat(grupo ~ SAEBLP+SAEBM+IDEB+APTOTAL,data=X,method="lda") partimat(grupo ~ SAEBLP+SAEBM+IDEB+APTOTAL,data=X,method="qda") densityplot(~ pred$x[,1], groups=dteste2$GRE,bw=1,xlab="Discriminante",ylab="Densidade", auto.key = list(space = "right", points = FALSE, lines = TRUE, title = "GRE", cex.title = 1)) library(pROC) resposta <- factor(ifelse(dteste2$GRE == "15ª GRE", 1, 0), levels = c(0,1)) HLDL = roc(resposta,pred$posterior[,1]) plot(HLDL)