Análise Preditiva Avançada: Naive Bayes, SVM e Redes Neurais

Analise Preditiva Avançada Aula Tópico 01 Naive Bayes 02 SVM 03 Redes Neurais (parte 1) 04 Redes Neurais (parte 2) 05 Técnicas de Seleção de Modelos AULA1 Naive Bayes no R ▶ Classificação/Composição de Imagem #library(rgdal) # spatial data processing library ( raster ); library ( dplyr ); library ( RStoolbox ); library ( RColorBrewer ); library ( sp ); library ( caret ); library ( doParallel ) # raster processing ; # data manipulation ; # Image analysis & plotting spatial data; # color; # spatial data; # machine learning ; # Parallel processing ## leitura dos dados data.loc <- "https://raw.githubusercontent.com/allanvc/data_FGV/master/image_naivebayes/" satellite_data <- paste0( data.loc , "satellite_data.csv" ) ## validation set set.seed ( 1984 ) idx_treino <- sample( 1 :nrow( satellite_data ), 0.7 * nrow ( satellite_data )) base_treino <- satellite_ data [ idx_treino , ] base_teste <- satellite_ data [ - idx_treino , ] ## setando execução paralela (para cross validation ) mc <- makeCluster ( detectCores ( )) registerDoParallel ( mc ) ## CV myControl <- trainControl ( method = " repeatedcv " , number = 3 , repeats = 2 , returnResamp = ' all ' , #all resampled summary metrics should be saved allowParallel = TRUE) set.seed ( 1984 ) fit.nb <- train ( as.factor ( Landuse )~B2+B3+B4+B6+B7+B8+B8A+B11+B12, data= base_treino , method = " nb " , metric = " Accuracy " , # accuracy ou rmse preProc = c( "center" , " scale " ), trControl = myControl ) fit.nb # parando os clusters de exec paralela stopCluster ( mc ) #predicao e confusion matrix para dados de teste pred1 <- predict ( fit.nb , base_teste , type = " raw " ) confusionMatrix ( pred1, as.factor ( base_teste$Landuse )) # predicao no grid/imagem: # leno csv com os dados do grid grid.df <- read.csv(paste0(data. loc , "prediction_grid_data.csv" ), header = T) # Preddict nos locais do grid pred_grid <- as. data.frame ( predict ( fit.nb , grid.df , type = " raw " )) # extraindo as classes de uso do solo grid.df$Landuse <- pred_grid$predict # lendo aqrquivo contendo IDs do tipo de uso do solo ID <- read.csv(paste0(data. loc , "Landuse_ID.csv" ), header= T) # juntando as bases grid.df e ID grid.new <- inner_ join ( grid.df , ID, by = " Landuse " ) # Omit missing values grid.new.na <- na.omit ( grid.new ) # converter para raster x <- SpatialPointsDataFrame ( as. data.frame (grid.new.na)[, c( "x" , "y" )], data = grid.new.na) r <- rasterFromXYZ ( as. data.frame (x)[, c( "x" , "y" , " Class_ID " )]) # salvar raster : # writeRaster( r, filename = "NB_Landuse.tiff", " GTiff ", overwrite =T) # plotagem: # Color Palette myPalette <- colorRampPalette ( c( "light grey" , "burlywood4" , " forestgreen " , "light green " , " dodgerblue " )) # Plot Map img <- spplot ( r, " Class_ID " , main = "Classificação Supervisionada de Imagem: Naive Bayes " , colorkey = list ( space = " right " , tick.number = 1 , height= 1 , width = 1.5 , labels = list ( at = seq ( 1 , 4.8 , length= 5 ), cex = 1.0 , lab = c( "Road/parking/ pavement " , "Building" , " Tree /bushes" , "Grass" , " Water " ))), col.regions = myPalette , cut = 4 ) img AULA 2 Demonstração de ajuste - SVM - Regressão no R df.loc <- "https://raw.githubusercontent.com/allanvc/data_FGV/master/reg_data_svm.txt" df <- read.table ( df.loc , sep = "," , header= TRUE) # Plot the data # plot( df, pch =16) # Create a linear regression model lin_model <- lm ( Y ~ X, df ) # Add the fitted line # plot( df, pch =16) #abline(lin_model) # make a prediction for each X predictedY <- predict ( lin_model , df ) # display the predictions # plot( df, pch =16) # points( df$X, predictedY , col = "blue", pch =4) library (e1071) svm_model <- svm ( Y ~ X , df ) predictedY <- predict ( svm_model , df ) plot ( df , pch = 16 ) points( df$X , predictedY , col = " red " , pch = 4 ) Exemplo 2 library ( caret ) ads.loc <- "https://raw.githubusercontent.com/allanvc/data_FGV/master/social.csv" ads <- read.csv( ads.loc ) # Encoding the target feature as factor ads$Purchased = factor ( ads$Purchased , levels = c( 0 , 1 )) # validation set set.seed ( 1984 ) idx_treino <- sample( 1 :nrow( ads ), 0.7 * nrow ( ads )) base_treino <- ads [ idx_treino , ] base_teste <- ads [ - idx_treino , ] # cv myControl <- trainControl ( method = "cv" , number = 5 ) # precisa do pacote kernlab svm_ads <- train ( Purchased ~ Gender + Age + EstimatedSalary , data = base_treino , method = " svmPoly " , trControl = myControl ) svm_ads y_pred = predict ( svm_ads , newdata = base_teste [,-c( 1 , 5 )]) confusionMatrix ( y_pred , base_teste$Purchased ) Exemplo 2 - modificado # soh com duas variaveis e usando kernel polynomial library ( caret ) ads.loc <- "https://raw.githubusercontent.com/allanvc/data_FGV/master/social.csv" ads <- read.csv( ads.loc ) # Encoding the target feature as factor ads$Purchased = factor ( ads$Purchased , levels = c( 0 , 1 )) ads [,c ( 3 , 4 )] <- scale ( ads [, c( 3 , 4 )]) # validation set set.seed ( 1984 ) idx_treino <- sample( 1 :nrow( ads ), 0.7 * nrow ( ads )) base_treino <- ads [ idx_treino , ] base_teste <- ads [ - idx_treino , ] # cv myControl <- trainControl ( method = "cv" , number = 5 ) # precisa do pacote kernlab svm_ads2 <- train ( Purchased ~ Age + EstimatedSalary , data = base_treino , method = " svmPoly " , trControl = myControl ) #svm_ads2 y_pred = predict ( svm_ads2, newdata = base_teste [,-c( 1 , 5 )]) confusionMatrix ( y_pred , base_teste$Purchased ) Visualização Classificação - Exemplo 2 modif . # visualizacao da separacao set = base_ teste [ , -c( 1 , 2 )] X1 = seq ( min(set[, 1 ]) - 1 , max (set[, 1 ]) + 1 , by = 0.01 ) X2 = seq ( min(set[, 2 ]) - 1 , max (set[, 2 ]) + 1 , by = 0.01 ) grid_set = expand.grid (X1, X2) colnames ( grid_set ) = c( 'Age' , ' EstimatedSalary ' ) y_grid = predict ( svm_ads2, newdata = grid_set ) plot ( set[, - 3 ], main = 'SVM (Test set)' , xlim = range(X1), ylim = range(X2)) contour ( X1, X2, matrix ( as.numeric ( y_grid ), length (X1), length (X2)), add = TRUE) points( grid_set , pch = '.' , col = ifelse ( y_grid == 1 , 'coral1' , ' aquamarine ' )) points( set, pch = 21 , bg = ifelse (set[, 3 ] == 1 , 'green4' , 'red3' )) AULA3 Instalação do Mini-Conda (ambiente Python) # instalação de pacotes tensorflow , keras com miniconda # install.packages (" reticulate ") # normalmente não é necessário install.packages ( " tensorflow " ) install.packages ( " keras " ) reticulate :: install_miniconda () AULA 4 Exemplo 1 - Implementação (2) # carregamento do dataset iris data( iris ) # mudamos as classes de 1 ,2, 3 para 0, 1 e 2 # ( nao eh um ponto critico ) iris [ , 5 ] <- as.numeric ( iris [, 5 ]) - 1 # transformando o dataframe em matriz, que eh o formato padrao # ... de entrada de dados na RN ajustada com Keras iris <- as.matrix ( iris ) # removendo nomes de "colunas" dimnames ( iris ) <- NULL # Normalizando as variáveis X pela amplitude # .... x/( max (x)-min(x)) # normalize eh uma funcao do proprio keras iris [ , 1 : 4 ] <- normalize( iris [, 1 : 4 ]) # Vaidation set treino/teste idx_treino <- sample( 1 :nrow( iris ), 0.7 * nrow ( iris )) # preditoras iris.training <- iris [ idx_treino , 1 : 4 ] iris.test <- iris [ - idx_treino , 1 : 4 ] # classes iris.trainingtarget <- iris [ idx_treino , 5 ] iris.testtarget <- iris [- idx_treino , 5 ] # transformando as classes em variaveis categorica (Hot encode) # treino iris.trainLabels <- to_categorical ( iris.trainingtarget ) # teste iris.testLabels <- to_categorical ( iris.testtarget ) Exemplo 1 - Implementação (2) # Criando o modelo no Keras # inicializando o modelo de RN model <- keras_model_ sequential ( ) # adicionando camadas (RN feedforward ) model %>% layer_ dense ( units = 8 , activation = ' relu ' , input_shape = c( 4 )) %>% # input das 4 variaveis preditoras sem # ... 8 neuronios e funcao de ativacao Rectified Linear Unit layer_ dense ( units = 3 , activation = ' softmax ' ) # ultima camada para classificacao # ... utilizando funcao softmax ( nao confundir com softplus ) # obtendo alguns detalhes sobre nosso modelo summary (model) Exemplo 1 - Implementação (3) # o proximo passo eh compilar o modelo model %>% compile( loss = ' categorical_crossentropy ' , # definindo a funcao perda # cross entropy eh o padrao quando temos problemas de classificacao optimizer = "adam" , # definindo o algoritmo de otmizacao # ... ADAM eh uma extensao do metodo de stochastic gradient descent # ... mais robusto a problemas de gradientes esparsos e com presenca de ruidos # ... foi desenvolvido justamente para aplicacao em redes neurais profundas metrics = " accuracy " # definindo a metrica aser usada na selecao do modelo ) # depois ajusta-se o modelo # OBS: vc verah alguns graficos sendo plotados automaticamente no RStudio model %>% fit ( x = iris.training , y = iris.trainLabels , # passando var. resposta e preditores epochs = 200 , # epocas definem o numero de ciclos para treino do modelo # eh um hiperparametro que pode ser otimizado por meio de cross validation , # ... mas nao faremos isso aqui batch_size = 5 , # define o numero de observacoes que serao propagadas pela RN a cada vez, # ... e.x . de 105 obs na base de treino, a rede serah alimentada em lotes de 5 em 5 # ... observacoes durante seu o treinamento validation_split = 0.2 , # define a proporcao do dataset de treino a ser utilizado # ... como validation set durate o treino ) # OBS: no keras hah a modificacao do objeto in place # ... isto significa que as funcoes compile e fit # ... modificarao o objeto model sem que seja necessario salvar as alteracoes em um novo objeto Exemplo 1 - Implementação (5) # predicoes # avaliando a acuracia geral do modelo jah na base de teste model %>% evaluate ( iris.test , iris.testLabels , verbose = 0 ) # visualizando as predicoes # visualizando as predicoes # note que eh bem parecido com o que jah vinhamos fazendo predictions <- predict ( model, iris.test ) head ( predictions , 2 ) # retorna as probabilidades de cada classe de plantas, ou seja # ... probabilidades de a especie ser 0, 1 ou 2 # transformando de probabilidades para classes predicted_classes <- apply ( predictions , 1 , function ( row ) which.max ( row )- 1 ) # retorna o indice da classe que apresentou a aior probabilidade em cada linha # ... precisamos subtrair 1 porque a primeira classe eh zero # Confusion matrix table ( iris.testtarget , predicted_classes ) Exemplo 1 - Implementação (6) # se você desejar, voce pode fazer outros testes criando modleos mais complexos # ... basta ir adiconando camadas a sua rede neral # Exemplo: model <- keras_model_ sequential ( ) # Adicionando camadas model %>% layer_ dense ( units = 8 , activation = ' relu ' , input_shape = c( 4 )) %>% layer_ dense ( units = 5 , activation = ' relu ' ) %>% layer_ dense ( units = 3 , activation = ' softmax ' ) # depois repete-se todo o processo de compilacao , ajuste, predicao , etc ▶ Convolutional Layer - Kernel Animação Exemplo 2 - Implementação (1) # carregamento do keras library ( keras ) # lembrar de copiar o dll para a pasta da CUDA NVIDIA # carregamento do dataset no GlobalEnvironment via keras mnist <- dataset_ mnist ( ) # demora # convertendo valores dos pixels para decimais entre 0s e 1s # Os dados de inpút são pixels, i.e. inteiros entre 0 e 255... # por isso, dividimos/normalizamos todos os valores por 255 mnist$train$x <- mnist$train$x / 255 mnist$test$x <- mnist$test$x / 255 # visualizar os digitos na base de treino # a ordem de leitura eh por colunas, da esquerda para direita par( mfcol = c( 6 , 6 )) par( mar= c( 0 , 0 , 3 , 0 ), xaxs = 'i' , yaxs = 'i' ) for ( idx in 1 : 36 ) { im <- mnist$train$ x [ idx ,,] im <- t( apply ( im , 2 , rev )) image ( 1 : 28 , 1 : 28 , im , col = gray (( 0 : 255 )/ 255 ), xaxt = 'n' , main = paste( mnist$train$y [ idx ])) } Exemplo 2 - Implementação (2) # definindo o modelo no keras usando o API sequencial model <- keras_model_ sequential ( ) %>% # avisa que vai criar um modelo do keras layer_ flatten ( input_shape = c( 28 , 28 )) %>% # achatamento do tensor de entrada # .... shape do input ==> imagens 28x28 pixels serao transformadas em um unico vetor layer_ dense ( units = 128 , activation = " relu " ) %>% # camadas de ativacao : 128 # ... neuronios com funcoes de ativacao Rectified Linear Unit layer_ dropout ( 0.2 ) %>% # metodo para aleatoriamente deixar nodos de fora da RN # ... durante treino. Ajuda a previnir overfitting em redes profundas layer_ dense ( 10 , activation = " softmax " ) # camada final com 10 neuronios # ... e funcao de ativacao softmax para realizar a classificacao final # ( nao confundir com softplus ) # verificando os parametros do modelo summary (model) Exemplo 2 - Implementação (3) # o proximo passo eh compilar o modelo model %>% compile( loss = " sparse_categorical_crossentropy " , # definindo a funcao perda optimizer = "adam" , # definindo o algoritmo de otmizacao # ... ADAM eh uma extensao do metodo de stochastic gradient descent # ... mais robusto a problemas de gradientes esparsos e com presenca de ruidos # ... foi desenvolvido justamente para aplicacao em redes neurais profundas metrics = " accuracy " # definindo a metrica aser usada na selecao do modelo ) # depois ajusta-se o modelo # OBS: vc verah alguns graficos sendo plotados automaticamente no RStudio model %>% fit ( x = mnist$train$x , y = mnist$train$y , # passando var. resposta e preditores epochs = 5 , # epocas definem o numero de ciclos para treino do modelo # eh um hiperparametro que pode ser otimizado por meio de cross validation , # ... mas nao faremos isso aqui validation_split = 0.3 , # define a proporcao do dataset de treino a ser utilizado # ... como validation set verbose = 2 # apresentar resultados no console ou nao # ... enquanto eh feito o ajuste do modelo ) # OBS: no keras hah a modificacao do objeto in place # ... isto significa que as funcoes compile e fit # ... modificarao o objeto model sem que seja necessario salvar em um novo objeto # predicoes # avaliando a acuracia geral do modelo jah na base de teste model %>% evaluate ( mnist$test$x , mnist$test$y , verbose = 0 ) Exemplo 2 - Implementação (4) # visualizando as predicoes # note que eh bem parecido com o que jah vinhamos fazendo predictions <- predict ( model, mnist$test$x ) head ( predictions , 2 ) # retorna as probabilidades de cada classe de numeros , ou seja # ... probabilidades de o numero escrito a mao ser # ... 0, 1 , 2, 3, 4, 5, 6, 7, 8, 9 # transformando de probabilidades para classes predicted_classes <- apply ( predictions , 1 , function ( row ) which.max ( row )- 1 ) # retorna o indice da classe que apresentou a aior probabilidade em cada linha # ... precisamos subtrair 1 porque a primeira classe eh zero # comparando predicao do modelo com a imagem dos numeros escritos a mao # ordem de leitura: por colunas, da esquerda para direita par( mfcol = c( 6 , 6 )) par( mar= c( 0 , 0 , 3 , 0 ), xaxs = 'i' , yaxs = 'i' ) for ( idx in 1 : 36 ) { im <- mnist$test$ x [ idx ,,] im <- t( apply ( im , 2 , rev )) image ( 1 : 28 , 1 : 28 , im , col = gray (( 0 : 255 )/ 255 ), xaxt = 'n' , main = paste( mnist$test$y [ idx ])) } Exemplo 2 - Implementação (5) # savando o modelo # eh sempre bom salvar um modelo de redes neurais para que se possa # ... utiliza-lo no futuro para fazer novas predicoes # Lembrar que o ajuste de uma rede neural pode levar semanas!! # vc nao vai querer perder esse tempo novamente save_model_ tf ( object = model, filepath = "model" ) # como recarregar o modelo jah treinado numa nova secao reloaded_model <- load_model_tf ( "model" ) all.equal ( predict (model, mnist$test$x ), predict ( reloaded_model , mnist$test$x )) AULA5 Ensemble em Machine Learning Exemplo 1 - Simple Averaging Simple Averaging (1) # simple average RL c/ L1, SVM, rf library ( caret ) # leitura dos dados: Advertising <- read.csv( 'https://raw.githubusercontent.com/nguyen-toan/ISLR/master/dataset/Advertising.csv' ) df <- Advertising [ ,- 1 ] # eliminando a primeira coluna que repete os indices das linhas set.seed ( 0821 ) # embora nao seja obrigatorio nesse caso, optamos por separar em treino/teste idx_treino <- sample( 1 :nrow( df ), 0.8 * nrow ( df )) #80/20 base_treino <- df [ idx_treino ,] base_teste <- df [- idx_treino ,] # ajustando os dados para usar regularizacao : X_treino <- data.matrix (base_treino[,-c((ncol(base_treino)- 1 ),ncol(base_treino))]) Y_treino <- base_treino$Sales # não pode ser matriz na regressão linear via glmnet # eliminando Sales & Newspaper X_teste <- data.matrix (base_teste[,-c((ncol(base_teste)- 1 ),ncol(base_teste))]) Y_teste <- base_teste$Sales # não pode ser matriz na regressão linear via glmnet library ( glmnet ) # encontrando o melhor lambda set.seed ( 1984 ) cv.lasso <- cv.glmnet ( X_treino , Y_treino , alpha = 1 ) # Definindo o tipo validação para todos os modelos train.control <- trainControl ( method = "cv" , number = 5 ) Simple Averaging (2) # Treinando cada modelo separadamente lm_l1 <- train ( y = Y_treino , x = X_treino , method = " glmnet " , #family = " gaussian ", ## ou: family = gaussian ( link = " identity "), tuneGrid = expand.grid ( alpha = 1 , lambda = cv.lasso$lambda.min ), trControl = train.control ) svm_poly <- train ( Sales ~ TV + Radio, data = base_treino , method = " svmPoly " , trControl = train.control ) rndfor <- train ( Sales ~ TV + Radio, data = base_treino , method = " rf " , trControl = train.control ) ## note: only 1 unique complexity parameters in default grid. Truncating the grid to 1 . Simple Averaging (3) # juntando os modelos em uma lista model_list <- list ( lm_l1, svm_poly , rndfor ) # criando uma funcao para fazer as predicoes individuais e ensemble avg_prediction <- function ( model_list , X_test ) { # usando somente os X's funciona pra todos # eh uma necessidade da glmnet p <- list ( ) for ( i in 1 :length( model_list )) { p[[i]] <- as.vector ( predict ( model_list [[i]], newdata = X_test )) } ensemble_predictions <- rowMeans ( Reduce ( cbind , p)) # servirah para probabilidade tb ! # ... em problemas de classificação names (p) <- paste0( "model" , 1 :length(p)) return ( c(p, "ensemble" = list ( ensemble_predictions ))) } preds <- avg_ prediction ( model_list , X_test = X_teste ) sapply ( preds , function (x) RMSE(x, Y_teste )) ## model1 model2 model3 ensemble ## 1.7828066 0.5873458 0.6424201 0.7580494 Exemplo 2 - Weighted Voting Weighted Voting # Weighted voting - classificacao # usa regressão linear para a obteção dos pesos # !!implementado na unha pq R nao tem pacotes bons de ensemble library ( caret ) # leitura dos dados df <- read.csv( "https://stats.idre.ucla.edu/ stat /data/binary.csv" ) # ajustes: df$admit <- factor ( df$admit , labels = c( "no" , " yes " )) # necessario no caret df$rank <- as.factor ( df$rank ) set.seed ( 0821 ) idx_treino <- sample( 1 :nrow( df ), 0.7 * nrow ( df )) #80/20 base_treino <- df [ idx_treino ,] base_teste <- df [- idx_treino ,] # Cross validation a ser utilizado em todos os modelos # seeds <- vector( mode = " list ", length = 6) # for (i in 1:( length ( seeds )-1)) seeds [[i]] <- c( 1984, 1984, 1984, 1984, 1984) # seeds [ [6]] <- 1984 # nao precisa e nao funciona!! my_control <- trainControl ( method = "cv" , # cv fica um pouco melhor que bootstrap #method="boot", number = 5 , #seeds=seeds, savePredictions = "final" , # quanto das hold -out predictions para cada resample # necessario para ensemble!!! classProbs = TRUE, # deve ser TRUE quando se utiliza twoClassSummary (binomial) index= createResample ( base_treino$admit , times= 5 ) # nro de particoes a serem criadas # precisa ser informado no ensemble #summaryFunction=twoClassSummary #twoClassSummary computes sensitivity , specificity and # ... the area under the ROC curve. # se for problema multiclasse , usar multiClassSummary # se queremos usar acuracia como metrica , nao especificarnada ... ir de default mesmo ) Weighted Voting (2) # ajustando os base models # set.seed (1984) # reg log politomica # caso tenhamos variavel resposta multiclasse , precisaremos de um modelo # ... logistico politomico (ou modelo multinomial ) multinom_model <- train ( admit ~ ., data = base_treino , method = ' multinom ' , trControl = my_control ) # colocar uma reg_log (binomial) depois para ver o resultadao # set.seed (1984) # naive bayes nb_model <- train ( admit ~ ., data = base_treino , method = ' nb ' , trControl = my_control ) # set.seed (1984) # random forest rf_model <- train ( admit ~ ., data = base_treino , method = ' rf ' , trControl = my_control ) # set.seed (1984) # support vector machine svm_model <- train ( admit ~ ., data = base_treino , method = ' svmRadial ' , trControl = my_control ) Weighted Voting (3) ## # weights : 7 (6 variable ) ## initial value 194.081211 ## iter 10 value 166.223574 ## final value 166.223555 ## converged ## # weights : 7 (6 variable ) ## initial value 194.081211 ## iter 10 value 166.714541 ## iter 10 value 166.714540 ## iter 10 value 166.714540 ## final value 166.714540 ## converged ## # weights : 7 (6 variable ) ## initial value 194.081211 ## iter 10 value 166.224120 ## final value 166.224101 ## converged ## # weights : 7 (6 variable ) ## initial value 194.081211 ## iter 10 value 149.026729 ## final value 149.026719 ## converged ## # weights : 7 (6 variable ) ## initial value 194.081211 ## iter 10 value 152.285869 ## final value 152.285863 ## converged ## # weights : 7 (6 variable ) ## initial value 194.081211 ## iter 10 value 149.031121 ## final value 149.031112 ## converged ## # weights : 7 (6 variable ) ## initial value 194.081211 ## iter 10 value 172.906961 ## final value 172.906959 Weighted Voting (4) # predicoes na base de teste pred_multinom <- predict ( multinom_model , newdata = base_teste ) pred_nb <- predict ( nb_model , newdata = base_teste ) pred_rf <- predict ( rf_model , newdata = base_teste ) pred_svm <- predict ( svm_model , newdata = base_teste ) # juntando num unico dataframe + classe original (target) finaldata <- data.frame ( model1= as.numeric ( pred_multinom ), model2= as.numeric ( pred_nb ), model3= as.numeric ( pred_rf ), model4= as.numeric ( pred_svm ), target= as.numeric ( base_teste$admit )) # ajustando um modelo glm para obter os pesos de cada variável #... por meio dos betas # normalmente se utiliza reg linear ou reg logistica # ... ( apliavel apenas quando se tem problemas de duas classes) # !! poderiamos incusive utilizar regularzacao L1 para fazer uma selecao # ... de modelos num caso em que temos muitos modelos testados como base models weight_model <- lm ( formula = target ~., data= finaldata ) #summary(weight_model) Weighted Voting (5) # limpando e ajustando os coeficientes do weight model # ... pois estes coef serao os pesos aplicados a cada um dos modelos base xx = data.frame ( summary ( weight_model )$ coefficient ) xx$variables = row.names ( xx ) row.names ( xx ) <- NULL xx = xx [ c( " variables " , " Estimate " )][- 1 ,] # transformamos os pesos em valores absolutos # ... para calcular a proporcao deles na soma total dos pesos xx$weight = abs ( xx$Estimate ) / sum( xx$Estimate ) # eliminando negativos finaldata <- finaldata -1 finaldata$EnsemblePred = apply ( finaldata [ , 1 : 4 ], 1 , function (x) round( weighted.mean (x, w= xx$weight ), 0 )) finaldata <- as. data.frame ( apply ( finaldata , 2 , as.factor )) confusionMatrix ( as.factor ( finaldata$EnsemblePred ), as.factor ( finaldata$target ), positive= "1" ) Weighted Voting (6) ## Confusion Matrix and Statistics ## ## Reference ## Prediction 0 1 ## 0 80 21 ## 1 5 14 ## ## Accuracy : 0.7833 ## 95% CI : (0.6989, 0.8533) ## No Information Rate : 0.7083 ## P- Value [ Acc > NIR ] : 0.041036 ## ## Kappa : 0.3942 ## ## Mcnemar’s Test P- Value : 0.003264 ## ## Sensitivity : 0.4000 ## Specificity : 0.9412 ## Pos Pred Value : 0.7368 ## Neg Pred Value : 0.7921 ## Prevalence : 0.2917 ## Detection Rate : 0.1167 ## Detection Prevalence : 0.1583 ## Balanced Accuracy : 0.6706 ## ## ’Positive’ Class : 1 ## Exemplo 3 – Stacking Stacking 1 #### stacked ensemble Advertising <- read.csv( 'https://raw.githubusercontent.com/nguyen-toan/ISLR/master/dataset/Advertising.csv' ) Advertising <- Advertising [ ,- 1 ] # separação das bases set.seed ( 1984 ) idx_treino <- sample( 1 : nrow( Advertising ), 0.7 * nrow ( Advertising )) base_treino <- Advertising [ idx_treino ,] base_teste <- Advertising [- idx_treino ,] #separando variável resposta y_treino <- base_treino$Sales y_teste <- base_teste$Sales #criando uma matriz das variáveis explicativas x_treino <- data.matrix ( base_treino [,- ncol ( base_treino )]) #elimina y x_teste <- data.matrix ( base_teste [,- ncol ( base_teste )]) #elimina y Stacking 1 (2) # ajustando modelos-base library ( glmnet ) library ( caret ) #k-fold cross-validation - achar valor lambda otimo (menor MSE) set.seed ( 1984 ) cv_lasso <- cv.glmnet ( x_treino , y_treino , alpha = 1 ) #alpha=1 p/ LASSO #guardando o valor de lambda best_lambda <- cv_lasso$lambda.min # Definindo o tipo validação train.control <- trainControl ( method = "cv" , number = 5 ) model1 <- train ( y = y_treino , x = x_treino , method = " lm " , trControl = train.control ) model2 <- train ( y = y_treino , x = x_treino , method = " glmnet " , family = " gaussian " , ## ou: family = gaussian ( link = " identity "), tuneGrid = expand.grid ( alpha = 1 , lambda = cv_lasso$lambda.min ), trControl = train.control ) model3 <- train ( y = y_treino , x = x_treino , method = " rf " , trControl = train.control ) ## note: only 2 unique complexity parameters in default grid. Truncating the grid to 2 . model4 <- train ( y = y_treino , x = x_treino , method = " svmPoly " , trControl = train.control ) Stacking 1 (3) # predicoes - treino e teste dos modelos-base # treino pred_model1_treino <- predict ( model1, newdata = x_treino ) pred_model2_treino <- predict ( model2, newdata = x_treino ) pred_model3_treino <- predict ( model3, newdata = x_treino ) pred_model4_treino <- predict ( model4, newdata = x_treino ) # teste pred_model1_teste <- predict ( model1, newdata = x_teste ) pred_model2_teste <- predict ( model2, newdata = x_teste ) pred_model3_teste <- predict ( model3, newdata = x_teste ) pred_model4_teste <- predict ( model4, newdata = x_teste ) base0_treino <- data.frame ( base_treino , model1 = pred_model1_treino, model2 = pred_model2_treino, model3 = pred_model3_treino, model4 = pred_model4_treino ) base0_teste <- data.frame ( base_teste , model1 = pred_model1_teste, model2 = pred_model2_teste, model3 = pred_model3_teste, model4 = pred_model4_teste ) Stacking 1 (4) # ajustando meta-model meta_control <- trainControl ( method = "cv" , # cv fica um pouco melhor que bootstrap #method="boot", number = 5 , savePredictions = "final" , # quanto das hold -out predictions para cada resample # necessario para ensemble!!! ) # meta model meta_model <- train ( Sales ~., data = base0_treino, method = ' rf ' , trControl = meta_control ) # embora algumas pessoas recomendem reg linear como meta model #... para problemas de regressao , pode ocorrer problema de as variaveis # ... de saida de alguns modelos serem perfeitaente correlacionadas # por isso, prefiro um metodo nao parametrico # predicao meta modelo na base nova de teste pred_meta_model <- predict ( meta_model , newdata = base0_teste) # note como melhoramos muito o RMSE do nosso modelo!!! # ... nem sempre isso serah possivel RMSE_df <- data.frame ( meta_model = RMSE( pred_meta_model , base0_teste$Sales), model1 = RMSE( pred_model1_teste, base0_teste$Sales), model2 = RMSE( pred_model2_teste, base0_teste$Sales), model3 = RMSE( pred_model3_teste, base0_teste$Sales), model4 = RMSE( pred_model4_teste, base0_teste$Sales)) Stacking 1 (5) library ( tidyr ) library ( dplyr ) library (ggplot2) RMSE_df_longer <- RMSE_df %>% pivot_ longer ( cols = contains ( "model" ), names_to = "models" ) %>% arrange ( desc ( value )) levels_desc_order <- RMSE_df_longer$models ggplot ( RMSE_df_longer )+ geom_ line ( mapping = aes ( x = factor (models, level = levels_desc_order ), y= value , group = 1 ))+ theme_ bw ( )+ xlab ( "modelos " )+ ylab ( "RMSE " )+ theme ( axis.text = element_text ( size = 4 ), axis.title = element_text ( size = 5 , face= " bold " ), axis.text.x = element_text ( angle = 45 )) Ensemble em Machine Learning Exemplo 4 – Stacking Stacking 2 #### stacked ensemble fires <- read.csv( "https://archive.ics.uci.edu/ml/machine-learning-databases/forest-fires/forestfires.csv" ) # ficando apenas com as variaveis informadas fires <- fires [ , c( " temp " , "RH" , " wind " , " rain " , " area " )] fires <- na.omit ( fires ) fires$area <- log( fires$area + 1 ) set.seed ( 1984 ) idx_treino <- sample( 1 :nrow( fires ), 0.8 * nrow ( fires )) base_treino <- fires [ idx_treino ,] base_teste <- fires [- idx_treino ,] y_treino <- base_treino$area y_teste <- base_teste$area #criando uma matriz das variáveis explicativas x_treino <- data.matrix ( base_treino [,- ncol ( base_treino )]) #elimina y x_teste <- data.matrix ( base_teste [,- ncol ( base_teste )]) #elimina y Stacking 2 (2) library ( glmnet ) library ( caret ) #k-fold cross-validation - achar valor lambda otimo (menor MSE) set.seed ( 1984 ) cv_lasso <- cv.glmnet ( x_treino , y_treino , alpha = 1 ) #alpha=1 p/ LASSO #guardando o valor de lambda best_lambda <- cv_lasso$lambda.min # Definindo o tipo validação train.control <- trainControl ( method = "cv" , number = 5 ) model1 <- train ( y = y_treino , x = x_treino , method = " glmnet " , family = " gaussian " , ## ou: family = gaussian ( link = " identity "), tuneGrid = expand.grid ( alpha = 1 , lambda = cv_lasso$lambda.min ), trControl = train.control ) model2 <- train ( y = y_treino , x = x_treino , method = " lm " , trControl = train.control ) model3 <- train ( y = y_treino , x = x_treino , method = " rf " , trControl = train.control ) model4 <- train ( y = y_treino , x = x_treino , method = " svmPoly " , trControl = train.control ) Stacking 2 (3) # predicoes - treino e teste # treino pred_model1_treino <- predict ( model1, newdata = x_treino ) pred_model2_treino <- predict ( model2, newdata = x_treino ) pred_model3_treino <- predict ( model3, newdata = x_treino ) pred_model4_treino <- predict ( model4, newdata = x_treino ) # teste pred_model1_teste <- predict ( model1, newdata = x_teste ) pred_model2_teste <- predict ( model2, newdata = x_teste ) pred_model3_teste <- predict ( model3, newdata = x_teste ) pred_model4_teste <- predict ( model4, newdata = x_teste ) base0_treino <- data.frame ( base_treino , model1 = pred_model1_treino, model2 = pred_model2_treino, model3 = pred_model3_treino, model4 = pred_model4_treino ) base0_teste <- data.frame ( base_teste , model1 = pred_model1_teste, model2 = pred_model2_teste, model3 = pred_model3_teste, model4 = pred_model4_teste ) Stacking 2 (4) # meta-model library ( caret ) meta_control <- trainControl ( method = "cv" , #method="boot", number = 5 , savePredictions = "final" , # quanto das hold -out predictions para cada resample # necessario para ensemble!!! ) # nro de particoes a serem criadas # meta model # como vamos usar um modelo nao parametrico como meta-model, nao precisaremos # da transformacao log aqui de novo meta_model <- train ( area ~., data = base0_treino, #metric="Accuracy", method = ' rf ' , #o method bate com o nome da função que utiliziaríamos fora do caret trControl = meta_control # que tipo de cross validation usar no caret ) # os warning sao pq alguns modelos sao perfeitamente correlacionados meta_model Stacking 2 (5) ## Random Forest ## ## 413 samples ## 8 predictor ## ## No pre-processing ## Resampling : Cross- Validated (5 fold ) ## Summary of sample sizes : 330, 331, 329, 332, 330 ## Resampling results across tuning parameters : ## ## mtry RMSE Rsquared MAE ## 2 0.8045937 0.6865671 0.5731668 ## 5 0.7107594 0.7457386 0.4434628 ## 8 0.7042670 0.7533226 0.4314872 ## ## RMSE was used to select the optimal model using the smallest value . ## The final value used for the model was mtry = 8. Stacking 2 (6) # resultados # fazer todo mundo como log e soh destransformar no final pred_meta_model <- predict ( meta_model , newdata = base0_teste) c( RMSE( exp ( pred_meta_model )- 1 , exp (base0_teste$area)- 1 ), RMSE( exp (pred_model1_teste)- 1 , exp (base0_teste$area)- 1 ), RMSE( exp (pred_model2_teste)- 1 , exp (base0_teste$area)- 1 ), RMSE( exp (pred_model3_teste)- 1 , exp (base0_teste$area)- 1 ), RMSE( exp (pred_model4_teste)- 1 , exp (base0_teste$area)- 1 )) ## [1] 25.55302 25.62298 25.62118 25.39541 25.99619 # sem efeito aparente