knitr::opts_chunk$set(
  message = FALSE,
  warning = FALSE,
  fig.align = 'center',
  tidy.opts = list(width.cutoff = 60),
  tidy = TRUE,
  comment = ""
)

Critérios usados na correção

Independentemente do software empregado, aplicam-se os seguintes critérios de avaliação:

Justificar sempre as escolhas metodológicas, não bastando apresentar apenas o código e/ou sua saída.
Manter o documento limpo, sem # desnecessários, warnings, erros ou descrições triviais.
Incluir tabelas e gráficos bem formatados, com títulos, legendas e rótulos claros para interpretação autônoma.
Organizar todo o código em apêndice/anexo, mantendo coerência, consistência e redação técnica objetiva.

Nota: Comentários sobre funções básicas (como set.seed() ou outras funções triviais) não devem ser incluídos.

Sugestões

Use pacman para instalar e importar pacotes numa só vez, evitando install.packages(), library() ou require para cada pacote.
Use knitr::opts_chunk$set(echo = TRUE, message = FALSE, warning = FALSE, comment = ""), para mostrar o código e a saída, ocultar mensagens automáticas, ocultar mensagens de aviso (warnings) na saída e remover o símbolo padrão (como ##) antes da saída do código, respectivamente.
Use pacotes como textreg ou stargazer, finalfit, flextable, equatiomatic, entre outros, para extração das estimativas do modelo e suas métricas em diferentes formatos (LaTeX, HTML, Word, colocar tabela única para vários modelos etc.), geração de tabelas formatadas e extração automática das equações/expressões matemáticas do modelo ajustado com ou sem as estimativas, respectivamente.

Instalação e importação de pacotes

if (!require(pacman)) install.packages("pacman")

pacman::p_load(
  caret, tidyverse, kableExtra, ISLR, astsa, stargazer, knitr, dplyr, 
  e1071, class, ggpubr, GGally, MASS, broom, pROC, flextable, finalfit,
  texreg, equatiomatic, dlookr, gridExtra, ggplot2
)

EXERCÍCIO 1

Item (a)

Nota: A função rnorm() por padrão simula valores de uma distribuição normal, com média 0 e desvio padrão 1. Caso precise usar média e desvio padrão diferentes, altere os parâmetros mean e sd em rnorm(n, mean = 0, sd = 1). Você pode rodar ?rnorm() para ver a documentação.

Item (b)

Sejam $\beta_0=30$, $\beta_1= 7.3$, $\beta_2= -3.6$ e $\beta_3=0.65$. O vetor Y, fica: $Y = \beta_0 + \beta_1 \cdot X + \beta_2 \cdot X^2 + \beta_3 \cdot X^3 + erros$

item c) Considere os $\beta_i$ desconhecidos, e estime-os usando a função Linear Models (lm).

\[ \operatorname{\widehat{Y}} = 30.1 + 7.29(\operatorname{X}) - 3.49(\operatorname{X\texttt{^}2}) + 0.64(\operatorname{X\texttt{^}3}) \]

Nota: No R, ao usar lm() para ajustar modelos de regressão, os operadores em fórmulas têm significados especiais. Especificamente, o operador ^ indica interações (:), não potências. Por exemplo, X^2 em uma fórmula é interpretado como X + X:X, o que não gera o termo quadrático.

Para incluir potências, usa-se I(), para operações matemáticas dentro de fórmulas no R, garantindo que potências e outras transformações sejam corretamente interpretadas. Assim:

Errado: lm(Y ~ X + X^2 + X^3), trata X^2 e X^3 como interações.
Correto: lm(Y ~ X + I(X^2) + I(X^3)),calcula de fato os quadrados e cubos de X.

Você pode utilizar alternativamente, a função poly(X, 3, raw = TRUE).

**Tabela 1: Estimativas dos parâmetros**

	Dependent variable:

	Y

Constant	30.105^*** (29.871, 30.338)
X	7.285^*** (6.957, 7.614)
I(X2)	-3.490^*** (-3.644, -3.335)
I(X3)	0.639^*** (0.540, 0.739)

Observations	100
R²	0.990
Adjusted R²	0.990
F Statistic	3,157.186^*** (df = 3; 96)

Note:	p<0.1; p<0.05; p<0.01

As estimativas mostradas na Tabela 1 possuem valores próximos àqueles que foram usados para simular 𝑌. Tanto o valor de $𝑅^2$ quanto o $Adj. R^2$ foi de 0,99, indicando que a curva estimada pelo modelo consegue explicar grande parte da variabilidade dos dados.

Para avaliar se o modelo realmente ficou bem ajustado, fizemos uma análise de resíduos na qual construímos os quatro gráficos mostrados na Figura 1, construídos usando a função plot(nome do seu modelo). No entanto, poderias usar (1) a curva ajustada aos dados (ver Figura 1.1 em anexo); (2) Resíduos vs Valores de X. A partir da análise desses gráficos, percebe-se que a curva realmente se ajustou bem aos dados e que a distribuição dos resíduos aparenta ter distribuição Normal, embora se observem caudas superior e inferior ligeiramente pesadas, sendo observações da posição 52, 18 e 14, respectivamente, possíveis causadoras.

Item d)

Para obter os estimadores Ridge e Lasso, usou-se validação cruzada (k-fold) com $k = 10$.

O valor de $\lambda$ ótimo encontrado para o Ridge foi 0,7531420 e para o Lasso foi 0,0284088 (Tabela 2).

Tabela 2: Resultados do ajuste dos modelos Ridge e Lasso
Parâmetros	Ridge	Lasso
$\text{Intercepto}$	29.8330722	30.0667078
$X$	6.3869093	7.2957728
$X^2$	-3.1801167	-3.4453696
$X^3$	0.7260167	0.6202547
$\alpha$	0.0000000	1.0000000
$\lambda$	0.7742637	0.0254335
$\text{EQM}$	1.1985167	0.9232486
$R^2$	0.9885362	0.9899502

EXERCÍCIO 2

O conjunto de dados Weekly traz os retornos semanais do índice S&P 500 (um dos principais índices da bolsa de valores dos Estados Unidos, usado para medir o desempenho das 500 maiores empresas de capital aberto dos EUA) entre 1990 e 2010, com 1089 registros.

Os retornos das semanas anteriores (Lag1 a Lag5) e do dia atual (“Today”) têm comportamentos parecidos: em média, são próximos de zero, mas com maior variabilidade (retornos distantes dos retornos médios) (Tabela 3 e Figura 3). A maioria dos valores se concentra entre -1,15 e 1,41 $(25\%$ a $75\%)$, porém há ocorrências extremas (valores muito altos ou baixos), indicando dias com mudanças bruscas. A distribuição é levemente inclinada para valores mais baixos, mas equilibrada entre altos e baixos no centro.

Já o volume de negócios (“Volume”) tem média mais alta (1,57) e variação menor que os retornos, com valores concentrados entre 0,33 e 2,05. A distribuição é assimétrica, com mais dias de volume moderado, mas alguns picos de alta atividade.

Assim, os retornos (passados e atuais) são imprevisíveis e instáveis, enquanto o volume tem padrão um pouco mais regular, embora também sujeito a flutuações. A repetição quase idêntica das estatísticas entre os “Lags” sugere que o comportamento do mercado não varia muito entre uma semana e outra.

Tabela 3:Principais medidas descritivas para todo o conjunto de dados
Variaveis	n	média	desvio padrao	IQR	Assimetria	curtose	Q1	Q2	Q3
Lag1	1,089	0.15	2.36	2.56	-0.48	5.72	-1.15	0.24	1.41
Lag2	1,089	0.15	2.36	2.56	-0.48	5.71	-1.15	0.24	1.41
Lag3	1,089	0.15	2.36	2.57	-0.48	5.67	-1.16	0.24	1.41
Lag4	1,089	0.15	2.36	2.57	-0.48	5.67	-1.16	0.24	1.41
Lag5	1,089	0.14	2.36	2.57	-0.48	5.66	-1.17	0.23	1.41
Volume	1,089	1.57	1.69	1.72	1.62	2.09	0.33	1.00	2.05
Today	1,089	0.15	2.36	2.56	-0.48	5.72	-1.15	0.24	1.41

Os dados mostram diferenças nas semanas em que o mercado caiu (“Down”) ou subiu (“Up”) (Tabela 4 e Figura 4). Quando o mercado caiu, o retorno da semana anterior (Lag1) foi ligeiramente maior, mas com alta variação. Nas semanas de alta, o retorno de duas semanas antes (Lag2) foi mais expressivo. O volume de ações negociadas foi similar em ambos os cenários, sugerindo que não está diretamente ligado à direção do mercado. O retorno do dia (“Today”) reflete claramente a tendência: negativo nas quedas e positivo nas altas. As semanas anteriores (Lags 3 a 5) não apresentaram padrões marcantes, indicando que a relação entre o passado recente e a direção do mercado é pouco clara ou inconsistente.

Tabela 4: Principais medidas descritivas considerando Direction
Dependent: Direction		Down	Up
Lag1	Mean (SD)	0.282 (2.315)	0.045 (2.387)
Lag2	Mean (SD)	-0.040 (2.292)	0.304 (2.399)
Lag3	Mean (SD)	0.208 (2.282)	0.099 (2.423)
Lag4	Mean (SD)	0.200 (2.443)	0.102 (2.293)
Lag5	Mean (SD)	0.188 (2.372)	0.102 (2.354)
Volume	Mean (SD)	1.609 (1.699)	1.547 (1.678)
Today	Mean (SD)	-1.747 (1.760)	1.667 (1.531)

Item b)

Ao nível de significância de $5\%$, a associação entre a resposta Direction e Lag1 não é estatisticamente significante, sugerindo, assim, que Lag1 não é um bom preditor para a Direction (Tabela 5).

**Tabela 1: Estimativas dos parâmetros**

	Dependent variable:

	Y

Constant	30.105^*** (29.871, 30.338)
X	7.285^*** (6.957, 7.614)
I(X2)	-3.490^*** (-3.644, -3.335)
I(X3)	0.639^*** (0.540, 0.739)

Observations	100
R²	0.990
Adjusted R²	0.990
F Statistic	3,157.186^*** (df = 3; 96)

Note:	p<0.1; p<0.05; p<0.01

\[ \log\left[ \frac { \widehat{P( \operatorname{Direction} = \operatorname{Up} )} }{ 1 - \widehat{P( \operatorname{Direction} = \operatorname{Up} )} } \right] = 0.23 - 0.04(\operatorname{Lag1}) \]

**Tabela 5: Estimativas do modelo de regressão Logística, com Direction (Up e Down) como variável resposta e variável Lag1 como preditora.**

	Dependent variable:

	Direction

Constant	0.230^*** (0.110, 0.350)
Lag1	-0.043 (-0.095, 0.008)

Observations	1,089
Log Likelihood	-746.733
Akaike Inf. Crit.	1,497.465

Note:	p<0.1; p<0.05; p<0.01

Item c)

A associação entre a resposta Direction e Lag1 não é estatisticamente significante ao nível de $5\%$, mas o coeficiente associado ao termo Lag2 é significativo (Tabela 5). Assim, convém fazer o ajuste apenas com a variável Lag2 como preditora.

\[ \log\left[ \frac { \widehat{P( \operatorname{Direction} = \operatorname{Up} )} }{ 1 - \widehat{P( \operatorname{Direction} = \operatorname{Up} )} } \right] = 0.22 - 0.04(\operatorname{Lag1}) + 0.06(\operatorname{Lag2}) \]

**Tabela 6: Estimativas do modelo de regressão Logística, com Direction (Up e Down) como variável resposta e variáveis Lag1 e Lag2 como preditoras**

	Dependent variable:

	Direction

Constant	0.221^*** (0.101, 0.342)
Lag1	-0.039 (-0.090, 0.013)
Lag2	0.060^** (0.008, 0.112)

Observations	1,089
Log Likelihood	-744.110
Akaike Inf. Crit.	1,494.220

Note:	p<0.1; p<0.05; p<0.01

item d)

Verifica-se que Lag2 é significativo a um nível de $5\%$ (Tabela 7). No entanto, observa-se na Figura 5 que há pouca área sob a curva ROC, sugerindo que o classificador não é bom.

\[ \log\left[ \frac { \widehat{P( \operatorname{Direction} = \operatorname{Up} )} }{ 1 - \widehat{P( \operatorname{Direction} = \operatorname{Up} )} } \right] = 0.2 + 0.06(\operatorname{Lag2}) \]

**Tabela 7: Estimativas do modelo de regressão Logística, com Direction (Up e Down) como variável resposta e variável Lag2 como preditora.**

	Dependent variable:

	Direction

Constant	0.203^*** (0.077, 0.329)
Lag2	0.058^** (0.002, 0.114)

Observations	985
Log Likelihood	-675.272
Akaike Inf. Crit.	1,354.543

Note:	p<0.1; p<0.05; p<0.01

A matriz de confusão (Tabela 8) foi construída classificando as observações que apresentassem estimativas de probabilidades menores que 0,5 como Down e maiores que 0,5 como Up. Verifica-se que a taxa de erro é de $37,5\%$. Vale observar que existe um tipo de erro mais comum: o de classificar como Up observações que têm valor verdadeiro Down.

Nota: A taxa de erro foi calculada como sendo 1 − acurácia (Tabela 9).

Tabela 8: Matriz de Confusão
	Real Down	Real Up
Previsto Down	9	5
Previsto UP	34	56

Tabela 9: Métricas do ajuste do modelo logistico
Acurácia	IC (95%)	Sensibilidade	Especificidade	Predit. Positivo	Predit Negativo
0.625	(0.5247, 0.718)	0.9180	0.2093	0.6222	0.6429

item e)

O método KNN (Tabela 10) apresenta resultados ainda menos acurados que a classificação baseada no modelo de Regressão Logística do item anterior, possuindo uma taxa de erro de $50\%$. Vale observar que há um equilíbrio maior entre os tipos de classificações erradas em comparação ao método que usava Regressão Logística. As métricas geradas para este método são apresentadas na Tabela 11.

Tabela 10: Matriz de Confusão do método KNN
	Real Down	Real Up
Previsto Down	21	30
Previsto UP	22	31

Tabela 11: Métricas do método KNN
Acurácia	IC (95%)	Sensibilidade	Especificidade	Predit. Positivo	Predit. Negativo
0.5	(0.4003, 0.5997)	0.5082	0.4884	0.5849	0.4118

item f)

A Regressão Logística apresenta melhores resultados, com uma maior acurácia, sensibilidade (classificar como Up quando realmente for Up) e precisão (as classificações em Up estarem certas), porém com menor especificidade (classificar Down quando o valor real for Down) (Tabela 12). Vale lembrar que, de modo geral, ambos os métodos não foram bons em realizar as classificações, apresentando uma alta taxa de erros (baixa acurácia).

Tabela 12: Regressão Logística vs KNN (k=1)
Métrica	Regressão_Logística	KNN_k1
Acurácia (IC 95%)	62.5% (52.5% - 71.8%)	50.0% (40.0% - 60.0%)
Sensibilidade (Up)	91.8%	50.8%
Especificidade (Down)	20.9%	48.8%
Valor Preditivo Positivo	62.2%	58.5%
Valor Preditivo Negativo	64.3%	41.2%

EXERCÍCIO 3

item a)

O código acima cria a variável mpg1, em que o valor 0 indica os veículos que fazem menos milhas medianas (mediana igual a 22,75) por galão, enquanto que o valor 1 indica os veículos que fazem mais milhas medianas (mediana igual a 22,75) por galão, e renomeia a variável origin conforme descrito no R ao rodar ?Auto.

item b)

Existe uma alta associação entre mpg1 e todas as demais variáveis investigadas (Figura 5):

Aparentemente, veículos que fazem menos milhas por galão possuem um maior número de cilindros;
Veículos que fazem menos milhas por galão são majoritariamente americanos, enquanto que os que fazem mais milhas por galão têm uma origem mais equilibrada entre europeus, americanos e japoneses;
Veículos que fazem menos milhas por galão possuem maiores cilindradas (displacement);
Veículos que fazem menos milhas por galão possuem mais cavalos de potência (horsepower);
Veículos que fazem menos milhas por galão são mais pesados (weight);
Veículos que fazem menos milhas por galão, em geral, possuem uma menor taxa de aceleração;
Veículos que fazem menos milhas por galão, em geral, são mais velhos (menor year).

Na Figura 6 é mostrada uma análise bivariada entre essas demais variáveis. Também é possível notar associação entre elas, com destaque para uma associação mais evidente entre (displacement x cylinders), (weight x cylinders), (horsepower x cylinders), (displacement x horsepower), (displacement x weight), (displacement x horsepower) e (weight x horsepower).
Os dados foram divididos de tal forma que cerca de $80\%$ das observações foram destinadas ao conjunto de treino e cerca de $20\%$ foram destinadas ao conjunto de teste.

item c)

Primeiramente, ajustou-se um modelo usando todas as variáveis disponíveis para discriminar mpg1 (apenas as variáveis quantitativas). Os centróides obtidos são exibidos na Tabela 13, enquanto que os coeficientes de discriminação (cargas padronizadas) são listados na Tabela 14. Chamando de W o vetor de cargas e de X a matriz de dados, os escores de discriminação são obtidos através da equação:

\[ \begin{multline} \text{Escore} = (-0{,}469 \times \text{Cylinders}) + (-0{,}001 \times \text{Displacement}) + (0{,}011 \times \text{Horsepower})\\ + (-0{,}001 \times \text{Weight})+ (-0{,}004 \times \text{Acceleration}) + (0{,}125 \times \text{Year}) \end{multline} \] e o valor de corte de classificação é calculado como: $\text{corte} = w' \times \frac{1}{2}(\bar{Y}_0 + \bar{Y}_1) = 4{,}31$ onde $\bar{Y}_0$ é o centróide (média dos escores) do grupo com $\text{mpg1} = 0$ e,$\bar{Y}_1$ é o centróide do grupo com $\text{mpg1} = 1$.

Assim, escores abaixo de 4,31 serão classificados como $\text{mpg1} = 0$ e, escores acima de 4,31 serão classificados como $\text{mpg1} = 1$.

Tabela 13: Estimativas médias por variável
mpg1	cylinders	displacement	horsepower	weight	acceleration	year
0	6.731	271.838	129.216	3,588.964	14.546	74.293
1	4.185	114.188	78.315	2,314.623	16.492	77.411

Tabela 14: Cargas da análise discriminante linear de Fisher
Variável	LD1
cylinders	-0.469
displacement	-0.001
horsepower	0.011
weight	-0.001
acceleration	-0.004
year	0.125

O gráfico (A) exibe os escores calculados para cada observação no conjunto de teste, o valor de corte (linha verde tracejada) e a sua categoria mpg1 original (Figura 7). Já a Tabela 15 resume os resultados das classificações usando os escores e o valor de corte. Verifica-se uma alta concordância entre os valores preditos e os verdadeiros.

Tabela 15: Matriz de Confusão da análise discriminante linear de Fisher
	Real Down	Real Up
Previsto Down	26	2
Previsto UP	3	48

Tabela 15.1: Métricas da análise discriminante linear de Fisher
Acurácia	IC (95%)	Sensibilidade	Especificidade	Predit. Positivo	Predit. Negativo
0.9367	(0.8584, 0.9791)	0.9600	0.8966	0.9412	0.9286

Tabela 16: Cargas da Análise Discriminante Linear de Fisher usando apenas cylin- ders e year
Variável	LD1
cylinders	-0.810
year	0.108

Tabela 17: Matriz de Confusão da análise Discriminante Linear de Fisher usando apenas cylinders e year)
	Real Down	Real Up
Previsto Down	26	2
Previsto UP	3	48

Tabela 17.1: Métricas da análise Discriminante Linear de Fisher usando apenas cylinders e year
Acurácia	IC (95%)	Sensibilidade	Especificidade	Predit. Positivo	Predit. Negativo
0.9367	(0.8584, 0.9791)	0.9600	0.8966	0.9412	0.9286

A taxa de erro de ambos os modelos é $6,3\%$. Um comparativo mais completo pode ser conferido na Tabela 18, onde observa-se que não há diferenças entre os dois modelos. Logo, já que ambos possuem a mesma taxa de erro, seria conveniente escolher aquele que é mais simples, ou seja, o que possui menos variáveis.

Nota: Vale ressaltar que os resultados obtidos são específicos aos conjuntos de treinamento e teste usados. Pequenas diferenças podem surgir a depender da separação dos conjuntos realizada.

Tabela 18: Comparativo de Métricas entre Análise Discriminante Linear (ADL) 1 e 2
Métrica	ADL1	ADL2
Acurácia (IC 95%)	93,7% (85,8% - 97,9%)	93,7% (85,8% - 97,9%)
Sensibilidade (Classe 1)	96,0%	96,0%
Especificidade (Classe 0)	89,7%	89,7%
Valor Preditivo Positivo	94,1%	94,1%
Valor Preditivo Negativo	92,9%	92,9%

item d)

Nos métodos KNN, usamos apenas as variáveis cylinders e year para fazer a classificação, visando torná-los mais comparáveis com o classificador de Discriminante Linear de Fisher obtido no item anterior. Utilizamos um range de 𝐾 indo de 1 a 10. Alguns testes mostraram que os resultados se mostraram estáveis para maiores valores de $𝐾 = 10$. A Tabela 19 apresenta os principais resultados dos modelos KNN. Aqueles com $𝐾 \geq 9$ apresentam a menor taxa de erro (0,063), mas, de modo geral, não houve muitas diferenças entre os classificadores. Escolhemos o método KNN com $𝐾 = 9$ por ter a menor taxa de erro, por usar uma quantidade razoável de vizinhos mais próximos para se fazer a classificação. A matriz de confusão do método escolhido é apresentada na Tabela 20. Não há a prevalência de um tipo de erro específico.

Nota: Vale ressaltar que os resultados obtidos são específicos aos conjuntos de treinamento e teste usados. Pequenas diferenças podem surgir a depender da separação dos conjuntos realizada.

Tabela 19: Resultados dos modelos KNN usando cylinders e year
K	Acurácia	Precisão	Sensibilidade	Especificidade	Taxa de Erro
1	0.924	0.958	0.92	0.931	0.076
2	0.911	0.957	0.90	0.931	0.089
3	0.924	0.958	0.92	0.931	0.076
4	0.924	0.958	0.92	0.931	0.076
5	0.924	0.958	0.92	0.931	0.076
6	0.924	0.958	0.92	0.931	0.076
7	0.924	0.958	0.92	0.931	0.076
8	0.924	0.958	0.92	0.931	0.076
9	0.937	0.941	0.96	0.897	0.063
10	0.937	0.941	0.96	0.897	0.063

Tabela 20: Matriz de Confusão do KNN com K=9
Predição/Real	Real Down	Real Up
Previsto Down	26	2
Previsto Up	3	48
Precisão = 0.941
Taxa de Erro = 0.063

item e)

Os classificadores KNN e o da Análise de Discriminante Linear de Fisher apresentaram resultados próximos entre si, havendo pequenas diferenças quando se analisam apenas as taxas de erro. Se o objetivo for apenas fazer classificação, o método KNN pode ser mais indicado do que a Análise de Discriminante Linear de Fisher por ter apresentado acurácia um pouco superior e por não depender das suposições Gaussianas.

Anexo 1: Código do Exercício 1

# Carregar pacotes
if (!require(pacman)) install.packages("pacman")
p_load(caret, tidyverse, kableExtra, ISLR, astsa, stargazer,
       knitr, dplyr, e1071, class, ggpubr, GGally, MASS, broom,
       knitr, pROC, texreg, equatiomatic, kableExtra)
##-----------------------------------------------------------------------
## 1a) Gerar dados
##-----------------------------------------------------------------------
  
set.seed(2023)
X = rnorm(100)
erros = rnorm(100)

##-----------------------------------------------------------------------
## 1b) Criar Y
##-----------------------------------------------------------------------
beta_0 = 30
beta_1 = 7.3
beta_2 = -3.6
beta_3 = 0.65
Y = beta_0 + beta_1 * X + beta_2 * X^2 + beta_3 * X^3 + erros

##-----------------------------------------------------------------------
## 1c) Ajustar modelo OLS
##-----------------------------------------------------------------------
OLS = lm(Y ~ X + I(X^2) + I(X^3))

# Exibir equação
equatiomatic::extract_eq(OLS, use_coefs = TRUE)

# Tabela 1
stargazer(OLS, 
          title = "Tabela 1: Estimativas dos parâmetros",
          type = 'html',
          ci.level = 0.95, 
          single.row = TRUE,
          omit.stat = c("ser"), 
          ci = TRUE,
          align = TRUE,
          intercept.bottom = FALSE)

# Figura 1
par(mfrow = c(2,2))  
#plot(OLS)
#mtext("Figura 1: Diagnóstico do modelo ajustado",outer = TRUE, cex = 1, line = -1)

#-----------------------------------------------------------------------
## Diagnóstico Alternativo, Figura 1.1
#-----------------------------------------------------------------------
par(mfrow = c(2,2))
# Relação X-Y
plot(Y ~ X, main = "")
x_seq = seq(min(X), max(X), length.out = 200)
y_pred = predict(OLS, newdata = data.frame(X = x_seq))
lines(x_seq, y_pred, col = "red", lwd = 2)

# Resíduos vs X
plot(OLS$residuals ~ X, ylab = "Resíduos")
abline(h = 0, col = "red", lwd = 2)

# Resíduos vs Ajustados
plot(OLS$residuals ~ OLS$fitted.values, 
     ylab = "Resíduos", 
     xlab = "Valores ajustados")
abline(h = 0, col = "red", lwd = 2)

# QQ-Plot
qqnorm(OLS$residuals, ylab = "Quantis amostrais", main = "")
qqline(OLS$residuals, col = "red", lwd = 2)

mtext("Figura 1.1: Diagnóstico do modelo ajustado",outer = TRUE, cex = 1, line = -1)

#-----------------------------------------------------------------------
## Ajuste de modelos Ridge e Lasso
#-----------------------------------------------------------------------
dados = tibble(Y = Y, X = X, X2 = X^2, X3 = X^3)
lambda = 10^seq(-3, 3, length = 1000)

# Ajustar Ridge
ridge = train(
  Y ~., 
  data = dados, 
  method = "glmnet",
  trControl = trainControl("cv", number = 10),
  tuneGrid = expand.grid(alpha = 0, lambda = lambda)
)

# Ajustar Lasso
lasso = train(
  Y ~., 
  data = dados, 
  method = "glmnet",
  trControl = trainControl("cv", number = 10),
  tuneGrid = expand.grid(alpha = 1, lambda = lambda)
)

# Criar dataframe dos resultados
Results = data.frame(
  Type = "ridge",
  alpha = ridge$bestTune$alpha,
  lambda = ridge$bestTune$lambda,
  RMSE = RMSE(predict(ridge, dados), dados$Y),
  Rsquare = R2(predict(ridge, dados), dados$Y)
)

Results = rbind(
  Results,
  data.frame(
    Type = "lasso",
    alpha = lasso$bestTune$alpha,
    lambda = lasso$bestTune$lambda,
    RMSE = RMSE(predict(lasso, dados), dados$Y),
    Rsquare = R2(predict(lasso, dados), dados$Y)
))

# Extrair coeficientes
ridge_coef = coef(ridge$finalModel, s = ridge$bestTune$lambda)
lasso_coef = coef(lasso$finalModel, s = lasso$bestTune$lambda)

# Criar dataframe das estimativas
FinalResults = data.frame(
  Parâmetros = c(
    "$\\text{Intercepto}$",
    "$X$",
    "$X^2$",
    "$X^3$",
    "$\\alpha$",
    "$\\lambda$",
    "$\\text{EQM}$",
    "$R^2$"
  ),
  Ridge = c(
    ridge_coef["(Intercept)", ],
    ridge_coef["X", ],
    ridge_coef["X2", ],
    ridge_coef["X3", ],
    ridge$bestTune$alpha,
    ridge$bestTune$lambda,
    RMSE(predict(ridge, dados), dados$Y),
    R2(predict(ridge, dados), dados$Y)
  ),
  Lasso = c(
    lasso_coef["(Intercept)", ],
    lasso_coef["X", ],
    lasso_coef["X2", ],
    lasso_coef["X3", ],
    lasso$bestTune$alpha,
    lasso$bestTune$lambda,
    RMSE(predict(lasso, dados), dados$Y),
    R2(predict(lasso, dados), dados$Y)
))

# Tabela 2 
Tabel2 <- FinalResults %>%
  kable(escape = FALSE, 
        caption = "Tabela 2: Resultados do ajuste dos modelos Ridge e Lasso", 
        booktabs = TRUE) %>%
  kable_styling(latex_options = c("hold_position", "striped"))

Anexo 2: Código do Exercício 2

# Carregar dados
data(Weekly) 
#-----------------------------------------------------------------------
## Exercício 2a)
#-----------------------------------------------------------------------
# Tabela 3
Tab_3 <- dlookr::describe(Weekly) 
colnames(Tab_3) <- c(
  "Variaveis", "n", "dados altantes", 
  "média", "desvio padrao", "erro padrao", 
  "IQR", "Assimetria", "curtose", 
  "p00", "p01", "p05", "p10", "p20", "Q1", 
  "p30", "p40", "Q2", "p60", "p70", "Q3", 
  "p80", "p90", "p95", "p99", "p100"
)

Tab_3 <- Tab_3[c(2:8), c(1:2,4:5,7:9,15,18,21)]

Tab_31 <- Tab_3[, -1] |> round(digits = 2)
cbind(Tab_3[, 1], Tab_31) |>
  flextable() |>
  set_caption(caption = "Tabela 3: Principais medidas descritivas para todo o conjunto de dados")

# Preparar gráficos
Weekly1 = Weekly[,-c(1)]
Weekly2 = Weekly
Weekly2$Year = as.factor(Weekly$Year)
levels(Weekly2$Year) = str_sub(levels(Weekly2$Year), 3, 4)

plot00 = ggplot(Weekly2) +
  theme_bw(base_size = 9) +
  theme(legend.key.size = unit(.3, "cm"),
        legend.box.spacing = unit(.3, "cm"))

# Criar boxplots
plot01 = plot00 + aes(y = Volume, x = Year) + geom_boxplot() + labs(y = "Volume", x = "Ano")
plot02 = plot00 + aes(y = Today,x = Year) + geom_boxplot() + labs(y = "Today", x = "Ano")
plot03 = plot00 + aes(y = Lag1, x = Year) + geom_boxplot() + labs(y = "Lag 01", x = "Ano")
plot04 = plot00 + aes(y = Lag2, x = Year) + geom_boxplot() + labs(y = "Lag 02", x = "Ano")
plot05 = plot00 + aes(y = Lag3, x = Year) + geom_boxplot() + labs(y = "Lag 03", x = "Ano")
plot06 = plot00 + aes(y = Lag4, x = Year) + geom_boxplot() + labs(y = "Lag 04", x = "Ano")
plot07 = plot00 + aes(y = Lag5, x = Year) + geom_boxplot() + labs(y = "Lag 05", x = "Ano")
plot08 = plot00 + aes(x = Year, group = Direction, fill = Direction) + 
  geom_bar() + labs(x = "Ano", y = "Contagem") + theme(legend.position = "top")

# Figura 3
#par(mfrow=c(4,2)) 
#plot01; plot02; plot03; plot04; plot05; plot06; plot07; plot08
#mtext("Figura 3: Gráficos descritivos das variáveis", outer=TRUE, line=-2, cex=1.2)

# Tabela 4
dependent="Direction"
explanatory=c("Lag1","Lag2","Lag3","Lag4","Lag5","Volume","Today")

Tabela4 <- Weekly |>
  summary_factorlist(
    dependent, explanatory, 
    p = FALSE, 
    cont_range = TRUE, 
    add_dependent_label = TRUE,
    digits = c(3, 3, 3, 3, 3) 
  ) |>
  flextable() |>
  set_caption(caption = "Tabela 4: Principais medidas descritivas considerando Direction")

# Figura 4
painelPlot = ggpairs(Weekly1) +
  theme_bw(base_size = 10) +
  theme(legend.key.size = unit(.3, "cm"),
        legend.box.spacing = unit(.3, "cm")) +
  labs(title = "Figura 4: Gráficos bivariados descritivos das variáveis")

#-----------------------------------------------------------------------
## 2b) Modelo logistico 1
#-----------------------------------------------------------------------
Ex02_Mod01 = glm(Direction ~ Lag1, data = Weekly, family = binomial(link = "logit")) 
Ex02_PredMod01 = factor(ifelse(predict.glm(Ex02_Mod01, type = "response") >= 0.5, "Up","Down"))
Ex02_ConfMat01 = confusionMatrix(Ex02_PredMod01, Weekly$Direction, positive = "Up")

equatiomatic::extract_eq(Ex02_Mod01,use_coefs = TRUE)
Tabela5 <- stargazer(Ex02_Mod01, 
          title="Tabela 5: Estimativas do modelo de regressão Logística", 
          type='html',
          ci.level=0.95, 
          single.row=TRUE,
          omit.stat=c("ser"), 
          ci=TRUE,
          align=TRUE,
          intercept.bottom = FALSE)

#-----------------------------------------------------------------------
## 2c) Modelo logistico 2
#-----------------------------------------------------------------------
Ex02_Mod02 = glm(Direction ~ Lag1 + Lag2, data = Weekly, family = binomial(link = "logit"))
Ex02_PredMod02 = factor(ifelse(predict.glm(Ex02_Mod02, type = "response") >= 0.5, "Up","Down"))
Ex02_ConfMat02 = confusionMatrix(Ex02_PredMod02, Weekly$Direction, positive = "Up")

eq <- equatiomatic::extract_eq(Ex02_Mod02,use_coefs = TRUE)
Tabela6 <- stargazer(Ex02_Mod02, 
          title="Tabela 6: Estimativas do modelo de regressão Logística", 
          type='html',
          ci.level=0.95, 
          single.row=TRUE,
          omit.stat=c("ser"), 
          ci=TRUE,
          align=TRUE,
          intercept.bottom = FALSE)

#-----------------------------------------------------------------------
## 2d) Modelo logistico 3
#-----------------------------------------------------------------------
Ex02_Treino = tibble(filter(Weekly, Year <= 2008 & Year >= 1990))
Ex02_Teste = tibble(filter(Weekly, Year > 2008 | Year < 1990))
Ex02_Mod03= glm(Direction ~ Lag2, family = binomial(link = "logit"), data = Ex02_Treino)

Ex02_PredMod03 = factor(ifelse(predict.glm(Ex02_Mod03, newdata = Ex02_Teste, type = "response") >= 0.5, "Up","Down"))
Ex02_ConfMat03 = confusionMatrix(Ex02_PredMod03, Ex02_Teste$Direction, positive = "Up")

eq2 <- equatiomatic::extract_eq(Ex02_Mod03,use_coefs = TRUE)
Tabela6 <- stargazer(Ex02_Mod03, 
          title="Tabela 7: Estimativas do modelo de regressão Logística", 
          type='html',
          ci.level=0.95, 
          single.row=TRUE,
          omit.stat=c("ser"), 
          ci=TRUE,
          align=TRUE,
          intercept.bottom = FALSE)

# Curva ROC
probabilidades <- predict(Ex02_Mod03, newdata = Weekly, type = "response")
curva_roc <- roc(response = Weekly$Direction, 
                 predictor = probabilidades,      
                 levels = c("Down", "Up"))

par(pty = "s")  
RocGraf <- plot(curva_roc, 
     print.auc = TRUE, 
     auc.polygon = TRUE, 
     main="Figura 5: Curva ROC do modelo logístico",
     xlab="Especificidade", 
     ylab="Sensibilidade")

par(pty = "m")  

# Tabela 8
confusion_matrix <- matrix(c(9, 5, 34, 56), nrow = 2,
                           dimnames = list("Prediction" = c("Previsto Down", "Previsto UP"),
                                           "Reference" = c("Real Down", "Real Up")))
confusion_matrix %>%
  kable(caption = "Tabela 8: Matriz de Confusão", booktabs = TRUE) %>%
  kable_styling(latex_options = c("hold_position", "striped"))

# Tabela 9
stats <- data.frame(
  Medida = c("Acurácia", "IC (95%)", "Sensibilidade", "Especificidade", "Predit. Positivo", "Predit Negativo"),
  Valor = c("0.625", "(0.5247, 0.718)", "0.9180", "0.2093", "0.6222", "0.6429")
)

stats_wide <- stats |> pivot_wider(names_from = Medida, values_from = Valor)
stats_wide |> flextable() |> set_caption(caption = "Tabela 9: Métricas do ajuste do modelo logistico")

#-----------------------------------------------------------------------
## 2e) KNN
#-----------------------------------------------------------------------
Ex02_modKNN01 = knn(Ex02_Treino[,c("Lag2")], Ex02_Teste[,c("Lag2")], Ex02_Treino$Direction, k = 1)
Ex02_ConfMat04 = confusionMatrix(Ex02_modKNN01, Ex02_Teste$Direction, positive = "Up")

# Tabela 10
confusion_matrix2 <- matrix(c(21, 30, 22, 31), nrow = 2,
                            dimnames = list("Prediction" = c("Previsto Down", "Previsto UP"),
                                            "Reference" = c("Real Down", "Real Up")))
Tabela10 <- confusion_matrix2 %>%
  kable(caption = "Tabela 10: Matriz de Confusão do método KNN", booktabs = TRUE) %>%
  kable_styling(latex_options = c("hold_position", "striped"))

# Tabela 11
stats_1 <- data.frame(
  Medida = c("Acurácia", "IC (95%)", "Sensibilidade", "Especificidade", "Predit. Positivo", "Predit. Negativo"),
  Valor = c("0.5", "(0.4003, 0.5997)", "0.5082", "0.4884", "0.5849", "0.4118")
)

stats_wide <- stats_1 |> pivot_wider(names_from = Medida, values_from = Valor)
stats_wide |> flextable() |> set_caption(caption = "Tabela 11: Métricas do método KNN")

#-----------------------------------------------------------------------
## 2f) Tabela 12
#-----------------------------------------------------------------------
comparativo <- data.frame(
  Métrica = c("Acurácia (IC 95%)", "Sensibilidade (Up)", "Especificidade (Down)", "Valor Preditivo Positivo", "Valor Preditivo Negativo"),
  Regressão_Logística = c("62.5% (52.5% - 71.8%)", "91.8%", "20.9%", "62.2%", "64.3%"),
  KNN_k1 = c("50.0% (40.0% - 60.0%)", "50.8%", "48.8%", "58.5%", "41.2%")
)

Tabela12 <- comparativo |> flextable() |> set_caption("Tabela 12: Regressão Logística vs KNN (k=1)")

Anexo 3: Código do Exercício 3

#-----------------------------------------------------------------------
## Exercício 3a)
#-----------------------------------------------------------------------
data(Auto)
AutoMod = tibble(Auto) %>%
  mutate(mpg1 = factor(ifelse(mpg < median(mpg), 0, 1)))
AutoMod$origin = fct_recode(factor(AutoMod$origin),
                            American = "1",
                            European = "2",
                            Japanese = "3")
#-----------------------------------------------------------------------
## Exercício 3b)
#-----------------------------------------------------------------------
# Figuras
AutoMod1 = AutoMod
AutoMod1$cylinders = as.factor(AutoMod1$cylinders)

plot00 = ggplot(AutoMod1) +
  theme_bw(base_size = 7) +
  theme(legend.key.size = unit(.3, "cm"),
        legend.box.spacing = unit(.3, "cm"),
        legend.position="none")

# Criar gráficos individuais
plot01 = plot00 + 
  aes(x = mpg1, y = cylinders, col = cylinders, shape = mpg1) +
  geom_jitter(width = 0.15, height = 0.15) +
  labs(y = "Number of cylinders", x = "Categorized miles per gallon", title = "(A) mpg1 X cylinders")

plot02 = plot00 + 
  aes(x = mpg1, fill = origin, group = origin) +
  geom_bar(stat = "count", position=position_dodge()) +
  labs(y = "Frequency", x = "Categorized miles per gallon", title = "(B) mpg1 X origin") +
  theme(legend.position="top", legend.text = element_text(size=5))

plot03 = plot00 + 
  aes(x = mpg1, y = displacement, fill = mpg1) +
  geom_boxplot() +
  labs(y = "Engine displacement (cu. inches)", x = "Categorized miles per gallon", title = "(C) mpg1 X displacement")

plot04 = plot00 + 
  aes(x = mpg1, y = horsepower, fill = mpg1) +
  geom_boxplot() +
  labs(y = "Engine horsepower", x = "Categorized miles per gallon", title = "(D) mpg1 X horsepower")

plot05 = plot00 + 
  aes(x = mpg1, y = weight, fill=mpg1) +
  geom_boxplot() +
  labs(y = "Vehicle weight (lbs.)", x = "Categorized miles per gallon", title = "(E) mpg1 X weight")

plot06 = plot00 + 
  aes(x = mpg1, y = acceleration, fill=mpg1) +
  geom_boxplot() +
  labs(y = "Time to accelerate (sec.)", x = "Categorized miles per gallon", title = "(F) mpg1 X acceleration")

plot07 = plot00 + 
  aes(x = mpg1, y = year, fill=mpg1) +
  geom_boxplot() +
  labs(y = "Model year (modulo 100)", x = "Categorized miles per gallon", title = "(G) mpg1 X year")

# Figura 5
par(mfrow=c(4,2)) 
#plot01; plot02; plot03; plot04; plot05; plot06; plot07
#mtext("Figura 5: Gráficos descritivos da variável mpg1 com as demais variáveis", outer=TRUE, line=-2, cex=1.2)

#Figura 6
AutoMod2 = AutoMod1
painelPlot1 = ggpairs(AutoMod2[,c("cylinders", "origin", "displacement", "horsepower", "weight", "acceleration", "year")]) +
  theme_bw(base_size = 10) +
  theme(legend.key.size = unit(.3, "cm"),
        legend.box.spacing = unit(.3, "cm")) +
  labs(title = "Figura 6: Gráficos e estatísticas descritivas bivariadas")


# Preparar dados para modelagem
set.seed(12345)
vet = sample(1:nrow(AutoMod), 0.8*nrow(AutoMod))
Ex03_Treino = AutoMod[vet,]
Ex03_Teste = AutoMod[-vet,]

#-----------------------------------------------------------------------
## Exercício 3c)
#-----------------------------------------------------------------------
# Modelo LDA 1
Ex03_Mod01 = lda(mpg1 ~ cylinders + displacement + horsepower + weight + acceleration + year,
                 data = Ex03_Treino, prior = c(0.5, 0.5))
Ex03_PredMod01 = predict(Ex03_Mod01, newdata = Ex03_Teste)
Ex03_ConfMat01 = confusionMatrix(Ex03_PredMod01$class, Ex03_Teste$mpg1, positive = "1")

# Modelo LDA 2
Ex03_Mod02 = lda(mpg1 ~ cylinders + year, data = Ex03_Treino, prior = c(0.5, 0.5))
Ex03_PredMod02 = predict(Ex03_Mod02, newdata = Ex03_Teste)
Ex03_ConfMat02 = confusionMatrix(Ex03_PredMod02$class, Ex03_Teste$mpg1, positive = "1")

# Tabelas 13
Tabela13 <- group_means |> 
  flextable() |> 
  set_caption("Tabela 13: Estimativas médias por variável") 

Tabela14 <- coeficientes_ld1 |> 
  flextable() |> 
  set_caption("Tabela 14: Cargas da análise discriminante linear de Fisher") 

# Tabela 15 e 15.5
Tabela15 <- confusion_matrix3 %>%
  kable(caption = "Tabela 15: Matriz de Confusão da análise discriminante linear de Fisher", booktabs = TRUE) %>%
  kable_styling(latex_options = c("hold_position", "striped"))

Tabela15.1 <- stats_wide2 |> 
  flextable() |>
  set_caption(caption = "Tabela 15.1: Métricas da análise discriminante linear de Fisher")

# Gráficos de scores
Figura7 <- grid.arrange(
  arrangeGrob(plot_A, plot_B, ncol = 2),  
  nrow = 2,
  heights = c(8, 1)
)

#mtext("Figura 7: Escores e valor de corte para classificação mpg1 usando LDA", outer=TRUE, line=-2, cex=1.2)

#-----------------------------------------------------------------------
## Exercício 3d) Modelos KNN
#-----------------------------------------------------------------------
Ex03_ModKNN01 = knn(Ex03_Treino[,c("cylinders","year")], Ex03_Teste[,c("cylinders","year")], Ex03_Treino$mpg1, k = 1)

# Tabela 19
Tabela19 <- resultados_knn|>
  flextable()|>
  set_caption("Tabela 19: Principais resultados do ajuste dos modelos KNN")

# Matriz de confusão K=9
Tabela20 <- matriz_k9 %>%
  rownames_to_column("Predição/Real") %>%
  flextable() %>%
  set_caption("Tabela 20: Matriz de Confusão do KNN com K=9")

Introdução à Ciência de Dados

Gabarito lista 2

Alex Monito Nhancololo

2025-04-28