Bibliotecas

rm(list=ls())               # limpa os objetos da ultima execução
options(scipen = 9999,      # inibe exibição de resultaos em notação científica
        digits = 8,         # limita o número de digitos das saídas do programa
        max.print = 6)      # limita o tamanho da saída do programa

library(magrittr)           # pacote para operadores semânticos %>%, %$%
library(dplyr)              # pacote para manipulação de dados
library(tidyr)              # pacote para manipulação de dados
library(kableExtra)         # pacote para formatar tabelas
library(readxl)             # pacote para ler e manipular arquivos xlsx
library(ggplot2)            # pacote para elaboração de gráficos
library(corrplot)           # pacote para visualização de correlações
library(knitr)              # pacote para visualização 
library(DT)                 # pacote para formatar tabelas
library(janitor)            # pacote para limpeza de nomes de colunas

Questão

Um analista da federação da agricultura e pecuária do Estado do Amazonas precificou o WACC de uma amostra composta por 35 empresas produtoras de óleos essenciais de plantas nativas da Amazônia. O sumário do custo de capital e da relação Dívida/PL segue abaixo. A partir das informações apresentadas, estime uma função para o WACC do setor e determine a razão Dívida/PL que deveria ser utilizada como referência.

# Dados fornecidos
Empresa <- c(1:34)
Div_PL <- c(0.0, 2.0, 4.0, 6.0, 8.0, 10.0, 12.0, 14.0, 16.0, 18.0, 20.0, 22.0, 24.0, 26.0, 28.0, 30.0, 32.0, 34.0, 36.0, 38.0, 40.0, 42.0, 44.0, 46.0, 48.0, 50.0, 52.0, 54.0, 56.0, 58.0, 60.0, 62.0, 64.0, 66.0)
WACC <- c(70.0, 79.0, 60.0, 72.0, 63.3, 40.0, 52.9, 45.0, 37.0, 45.0, 38.0, 35.0, 20.0, 24.9, 20.0, 25.0, 21.0, 15.0, 16.0, 15.0, 30.0, 23.0, 30.0, 25.0, 37.0, 40.0, 55.0, 54.0, 63.0, 60.0, 75.0, 90.0, 110.0, 125.0)

# Criação do data frame
df <- data.frame(Empresa, Div_PL, WACC)

# Exibição dos dados
kable(df, "html", align = "c") %>%
  kable_styling("striped", full_width = F) %>%
  column_spec(1, width = "50px") %>%
  column_spec(2, width = "50px")
Empresa Div_PL WACC
1 0 70.0
2 2 79.0
3 4 60.0
4 6 72.0
5 8 63.3
6 10 40.0
7 12 52.9
8 14 45.0
9 16 37.0
10 18 45.0
11 20 38.0
12 22 35.0
13 24 20.0
14 26 24.9
15 28 20.0
16 30 25.0
17 32 21.0
18 34 15.0
19 36 16.0
20 38 15.0
21 40 30.0
22 42 23.0
23 44 30.0
24 46 25.0
25 48 37.0
26 50 40.0
27 52 55.0
28 54 54.0
29 56 63.0
30 58 60.0
31 60 75.0
32 62 90.0
33 64 110.0
34 66 125.0

Modelo de regressão

# Ajuste do modelo de regressão quadrática
model <- lm(WACC ~ poly(Div_PL, 2, raw = TRUE))

# Coeficientes do modelo
coefficients <- coef(model)
a <- coefficients[3]  # Coeficiente do termo quadrático
b <- coefficients[2]  # Coeficiente do termo linear
c <- coefficients[1]  # Coeficiente do termo constante

# Exibição do completa do modelo
model$coefficients
##                  (Intercept) poly(Div_PL, 2, raw = TRUE)1 
##                 87.558347339                 -4.421748233 
## poly(Div_PL, 2, raw = TRUE)2 
##                  0.071739918
summary(model)
## 
## Call:
## lm(formula = WACC ~ poly(Div_PL, 2, raw = TRUE))
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -17.55835  -5.38319   0.00235   5.46741  16.77796 
## 
## Coefficients:
##                                Estimate Std. Error t value
## (Intercept)                  87.5583473  4.0650254  21.539
##                                           Pr(>|t|)    
## (Intercept)                  < 0.00000000000000022 ***
##  [ reached getOption("max.print") -- omitted 2 rows ]
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 8.3703 on 31 degrees of freedom
## Multiple R-squared:  0.91007,    Adjusted R-squared:  0.90427 
## F-statistic: 156.85 on 2 and 31 DF,  p-value: < 0.000000000000000222

Função Quadrática

# Função quadrática
quadratic_function <- function(x) {
  return(a * x^2 + b * x + c)
}

# Previsões
WACC_pred <- quadratic_function(Div_PL)

\[ WACC = a \cdot Div\_PL^2 + b \cdot Div\_PL + c \]

\[ WACC = 0.07173992 \cdot Div\_PL^2 -4.42174823 \cdot Div\_PL + 87.55834734 \]

Gráfico

# Plot dos dados e da curva de regressão
plot(Div_PL, WACC, col = "blue", pch = 16, xlab = "Div/PL", ylab = "WACC", main = "Regressão Quadrática")
lines(Div_PL, WACC_pred, col = "red", lwd = 2)
legend("topright", legend = c("Dados Observados", "Regressão Quadrática"), col = c("blue", "red"), lwd = 2, pch = c(16, NA))

Determinação da razão Dívida/PL que minimiza o WACC

# Determinação da razão Div/PL que minimiza o WACC
optimal_div_pl <- -b / (2 * a)
min_wacc <- quadratic_function(optimal_div_pl)
cat("\nRazão Div/PL que minimiza o WACC:", optimal_div_pl, "%\n")
## 
## Razão Div/PL que minimiza o WACC: 30.817907 %
cat("WACC mínimo estimado:", min_wacc, "%\n")
## WACC mínimo estimado: 19.423834 %