Aprendizagem das Máquinas

Questão 1

O banco de dados apresentado, trata de restaurante que são ou não Michelin. O banco contém 6 variáveis, ao todo são apenas 164 observações.

Transformando as variáveis

library(tidymodels)
library(dplyr)
library(visdat)
library(skimr)
library(recipes)
library(pROC)
library(readxl)
library(knitr)
library(stargazer)
library(yardstick)

MichelinNY <- read.csv("C:/Users/elton/Downloads/MichelinNY.txt")
tidymodels::tidymodels_prefer()

Transformando as variáveis

MichelinNY<- MichelinNY |>
  rename(c(endereço=Adress,comida=Food,decoraçao=Decor,                                    serviço=Service,preço=Price))

MichelinNY$endereço<- as.factor(as.character(MichelinNY$endereço))

MichelinNY$comida<- as.numeric(as.integer(MichelinNY$comida))
MichelinNY$decoraçao<- as.numeric(as.integer(MichelinNY$decoraçao))
MichelinNY$serviço<- as.numeric(as.integer(MichelinNY$serviço))
MichelinNY$preço<- as.numeric(as.integer(MichelinNY$preço))
MichelinNY$InMichelin <- factor(MichelinNY$InMichelin, levels = c(0,1),labels = c("naoMichelin", "Michelin"))

Descritiva dos dados

vis_dat(MichelinNY)

skim(MichelinNY)

── Data Summary ────────────────────────
                           Values    
Name                       MichelinNY
Number of rows             164       
Number of columns          6         
_______________________              
Column type frequency:               
  factor                   2         
  numeric                  4         
________________________             
Group variables            None      

Divisão Inicial e Receita

set.seed(0) 
divisao_inicial <- rsample::initial_split(MichelinNY, prop = 0.8, strata ="InMichelin")
treinamento <- rsample::training(divisao_inicial)
teste <- rsample::testing(divisao_inicial) 

receita <- 
  treinamento |> recipe(formula = InMichelin ~ .) |> 
    
  recipes::step_dummy(all_nominal(), -all_outcomes()) |>  
  recipes::step_zv(all_numeric(), -all_outcomes()) |> 
  recipes::step_corr(all_predictors(), threshold = 0.7, method = "spearman")

Configurando o Modelo

log_reg <-
  logistic_reg(penalty = tune(), mixture = tune()) |>  
  set_engine(engine = "glmnet") |> 
  set_mode("classification")

Validação Cruzada

validacao_cruzada <- 
  treinamento |> 
  rsample::vfold_cv(v = 5L, strata = InMichelin)

Workflow

wf_todos <- workflow_set(
  preproc = list(receita),
  models = list(modelo_log = log_reg)
) |> 
  mutate(wflow_id = gsub("(recipe_)", "", wflow_id))
controle_grid <- control_grid(
  save_pred = TRUE,
  save_workflow = TRUE,
  parallel_over = "resamples"
)
metrica <- metric_set(accuracy, roc_auc)

Treinando o Modelo

treino <-
  wf_todos |> 
  workflow_map(
    resamples = validacao_cruzada,
    grid = 20L,
    control = controle_grid
  )

Verificando os melhores Hiperparametro

best = treino |> 
  extract_workflow_set_result("modelo_log") |>  
  select_best(metric = "roc_auc")

best |> 
  knitr::kable()

penalty	mixture	.config
0.0185454	0.997221	Preprocessor1_Model20

test <-  treino |> 
  extract_workflow("modelo_log") |>  
  finalize_workflow(best) |> 
  last_fit(split = divisao_inicial,
           metrics = metric_set(accuracy, roc_auc))

Testando em uma matriz de confusão

predictions <- test |> 
  collect_predictions()

matriz_confusão <- predictions |> 
  conf_mat(InMichelin, .pred_class)

round(prop.table(matriz_confusão$table),2) |> 
  knitr::kable()

	naoMichelin	Michelin
naoMichelin	0.48	0.12
Michelin	0.06	0.33

NA
NA

melhores <- 
  treino |> 
  rank_results(select_best = TRUE, rank_metric = c( "roc_auc")) 
stargazer::stargazer(melhores,summary = F,type = "text")

=================================================================================================================
   wflow_id         .config        .metric        mean             std_err       n preprocessor    model     rank
-----------------------------------------------------------------------------------------------------------------
1 modelo_log Preprocessor1_Model20 accuracy 0.777356125356125 0.0322521598740875 5    recipe    logistic_reg  1  
2 modelo_log Preprocessor1_Model20 roc_auc  0.858391053391053 0.0248715845505386 5    recipe    logistic_reg  1  
-----------------------------------------------------------------------------------------------------------------

curva_roc <- roc_curve(predictions,InMichelin, .pred_naoMichelin) 
roc_auc(predictions, InMichelin, .pred_naoMichelin)

autoplot(curva_roc)

O modelo apresentado tem desempenho superior a qualquer modelo feito de forma aleatório, mostrando com isso, a eficiência dos modelos de machine learning.

Salvando o Modelo

#Salvando o modelo em um arquivo serializado

#saveRDS(test, file = "modelo_final_questao1.rds")

# Lendo o arquivo serializado com o modelo final
#load(file = "modelo_final_questao1.rds")

# Fazendo novas previsões

#predict(modelo_final_questao1, new_data = data_novo)

Questão 2

A-Explique resumidamente o que é aprendizagem supervisionada e não-supervisionada. Cite um problema de aprendizagem supervisionada e um outro de aprendizagem não-supervisionada.

Supervisionada utiliza conjuntos de dados rotulados, sem a necessidade de uma pessoa externa para compreender o assunto.

Não supervisionada é quando não temos a resposta correta do conteudo, ou seja, temos a necessidade de pessoas externas para entendimento do assunto.

B- Explique qual o motivo que faz com que o Erro Quadrático Médio - EQM para avaliar o desempenho de um modelo é ruim quando não adotamos nenhuma estratégia de divisão do conjunto de dados em treinamento e teste.

Considere a variável aleatória \(Y_i \sim N (sin (X_i),\sigma^2)\) , com \(X_i\) \(\epsilon\) \(U (0,10)\) , \(\forall_i\) . Utilizando a biblioteca \(rpart\), implemente a função arvore(n=250L,complexidade,sigma =0.1) que devolva o gráfico scatterplot com os pontos \(X_i\) e \(Y_i\) e por cima deles o gráfico de linha com os valores preditos. A função deverá ter três argumentos , n,complexidade e sigma, que são tamanho da amostra, o grau de complexidade do modelo, e o desvio padrão, respectivamente. Aqui não se preocupe com divisão entre treino e teste nem de validação cruzada. A solução desse exercício não tem como objetivo encontrar o melhor hiperparâmetro , \(i.e\), não é necessário tunar o parâmetro de complexidade.

library(rpart)
library(ggplot2)
library(tidymodels)
library(tibble)
library(dplyr)
library(workflows)
tidymodels::tidymodels_prefer()

arvore <- function(n = 250, complexidade, sigma = 0.1) {
X <- runif(n, 0, 10)
  
Y <- sin(X) + rnorm(n, mean = 0, sd = sigma)
  
df <- data.frame(X = X, Y = Y)
  
modelo_arvore <- rpart(Y ~ X, data = df, control = rpart.control(cp = complexidade))
  
plot(X, Y, main = "Gráfico de Dispersão e Árvore de Regressão", xlab = "X", ylab = "Y", pch = 19)
  
curve(predict(modelo_arvore, data.frame(X = x)), from = 0, to = 10, add = TRUE, col = "red")
}
arvore(n = 250, complexidade = 0.01, sigma = 0.1)

NA
NA

Sem utilizar a biblioteca tidymodels, apenas as bibliotecas rsample e rpart, treine um modelo com 10 mil observações geradas. No procedimento \(k-folds\) \(cross-validation\), para \(k=20\) , encontre um bom valor para o grau de complexidade considerando um grid de possíveis valores. Dica: experimente testar um parâmetro dentro do conjunto de treino no procedimento de cross-validation. Por exemplo, experimente criar um grid com valores entre \(0.001\) \(0.001\) e \(0.4\) 0.4. Aprensente o gráfico com a estimativa do melhor modelo. Não esqueça de fixar um valor de semente, para que os resultados possam ser reproduzidos.

estimar_e_plotar_arvores <- function(n = 250, num_arvores = 10, complexidade, sigma = 0.1) {
resultados <- data.frame(X = rep(0, n), Y_pred = rep(0, n))
  
for (i in 1:num_arvores) {
   
X <- runif(n, 0, 10)
    
    
Y <- sin(X) + rnorm(n, mean = 0, sd = sigma)
    
   
df <- data.frame(X = X, Y = Y)
    
    
modelo_arvore <- rpart(Y ~ X, data = df, control = rpart.control(cp = complexidade))
    
    
X_pred <- seq(0, 10, length.out = n)
    
    
Y_pred <- predict(modelo_arvore, data.frame(X = X_pred))
    
   
resultados <- data.frame(X = X_pred, Y_pred = resultados$Y_pred + Y_pred / num_arvores)
  }
  
 
ggplot(resultados, aes(x = X, y = Y_pred)) +
    geom_line(color = "blue") +
    ggtitle("Estimativas de Múltiplas Árvores de Regressão") +
    xlab("X") + ylab("Y Predito")
}


estimar_e_plotar_arvores(n = 250, num_arvores = 10, complexidade = 0.01, sigma = 0.1)

NA
NA
NA

Questão 3

Construa um modelo para previsão do valor do imóvel. Considere apenas casas e apartamentos.

imoveissalvador<- read.csv("C:/Users/elton/Downloads/salvador djl.csv", header=FALSE)

imoveissalvador<- imoveissalvador |> select(c(-V1,-V2,-V11,-V26,-V27,-V10))

imoveissalvador<- 
  imoveissalvador |> rename(c(valor=V3,area=V4,
                    iptu=V5,condominio=V6,quarto=V7,
                    vaga=V8,banheiro=V9,
                                          tipo=V12,area_servico=V13,espaco_gourmet=V14,piscina=V15,elevador=V16,salao_de_festa=V17,academia=V18,playground=V19,quadra_esporte=V20,portaria_24h=V21,varanda_gourmet=V22,sauna=V23,spa=V24,comercio=V25,))
imoveissalvador<- imoveissalvador[-1,]
imoveissalvador <- imoveissalvador |>  
  filter(tipo == "casas" | tipo == "apartamentos") |> select(-comercio)

Descritiva dos dados

dados <- dados_expectativa_renda[,-1]

Error: object 'dados_expectativa_renda' not found

skim(imoveissalvador)

── Data Summary ────────────────────────
                           Values         
Name                       imoveissalvador
Number of rows             16944          
Number of columns          22             
_______________________                   
Column type frequency:                    
  character                22             
________________________                  
Group variables            None           

Divisão Inicial e Receita

set.seed(0) 
divisao_inicial1 <- rsample::initial_split(imoveissalvador, prop = 0.8, strata ="valor")
treinamento1 <- rsample::training(divisao_inicial1) 
teste1 <- rsample::testing(divisao_inicial1)

receita1 <- 
  
  treinamento1 |> 
  recipe(formula = valor ~ . , imoveissalvador) |> 
  step_impute_knn(all_predictors(),
                  impute_with = c("iptu","condominio","vaga","quarto","banheiro"),
                  neighbors = 15L) |> 
  step_bin2factor(all_logical_predictors()) |> 
  step_dummy(all_nominal_predictors()) |> 
  step_YeoJohnson(all_numeric_predictors()) |> 
  step_normalize(all_numeric_predictors()) |> 
  step_zv(all_numeric_predictors()) |> 
  step_corr(all_numeric_predictors())

Configurando os Modelos

modelo_elastic <- 
  parsnip::linear_reg(penalty = tune::tune(), mixture = tune::tune()) |> 
  parsnip::set_mode("regression") |> 
  parsnip::set_engine("glmnet")

modelo_knn <-
  parsnip::nearest_neighbor(
    neighbors = tune::tune(),
    dist_power = tune::tune(), 
    weight_func = "gaussian" 
  ) |> 
  parsnip::set_mode("regression") |> 
  parsnip::set_engine("kknn")

modelo_svm <- 
  parsnip::svm_rbf(
    cost = tune::tune(),
    rbf_sigma = tune::tune(),
    margin = tune::tune()
  ) |> 
  parsnip::set_mode("regression") |> 
  parsnip::set_engine("kernlab")

modelo_arvore <- decision_tree(cost_complexity = tune(), tree_depth = tune(),
                         min_n = tune()) |> 
  set_engine(engine = "rpart") |> 
  set_mode("regression")

modelo_floresta <- 
  rand_forest(mtry = tune(), min_n = tune(), trees = tune()) |>   
  set_engine(engine = "ranger", importance = "impurity") |> 
  set_mode("regression")

modelo_bootstrep <- xgb <- boost_tree(tree_depth = tune(), learn_rate = tune(),
                        loss_reduction = tune(), min_n = tune(),
                        sample_size = tune(), trees = tune()) |> 
   set_engine(engine = "xgboost") |> 
   set_mode("regression")

Validação Cruzada

validacao_cruzada1 <- 
  treinamento1 |> 
  rsample::vfold_cv(v = 5L, strata = valor)

Worflow

wf_todos1 <-
  workflow_set(
    preproc = list(receita1),
    models = list(
      knn_fit = modelo_knn,
      elastic_fit = modelo_elastic,
      svm_fit = modelo_svm,
      arvore_fit<- modelo_arvore,
      floresta_fit<- modelo_floresta,
       boot_fit<- modelo_bootstrep
    ),
    cross = TRUE
  )


controle_grid1 <- control_grid(
  save_pred = TRUE,
  save_workflow = TRUE,
  parallel_over = "resamples"
)

Treinando o Modelo

treino1 <-
  wf_todos1 |> 
  workflow_map(
    resamples = validacao_cruzada1,
    grid = 20L,
    control = controle_grid1
  )

Melhores

melhores3 <- 
  treino3 |> 
  rank_results(select_best = TRUE, rank_metric = "rmse")
autoplot(treino1, select_best = TRUE)
treino3 |> 
  rank_results()

melhor_modelo <- 
  treino1 |> 
  extract_workflow_set_result(id = "recipe_1_rand_forest") |> 
  select_best(metric = "rmse")

wf_final3 <- 
  treino1 |> 
  extract_workflow(id = "recipe_1_rand_forest") |> 
  finalize_workflow(melhor_modelo)

teste2 <- 
  wf_final3 |> 
  last_fit(split = divisao_inicial1)

teste2$.metrics

Modelo final

modelo_final <- 
  wf_final3 |> 
  fit(imoveissalvador)
modelo_final