Aderência de Carteira
Bruno Czarnescki
21/05/2021
Objetivo
O presente artigo tem o objetivo de descrever a metodologia utilizada para a elaboração do método de classificação de aderência de carteiras, e também servir de material de consulta para eventuais dúvidas na utilização da ferramenta de BI.
Descrição do problema
Estou enviando em anexo a este email uma planilha que contém dados fakes e aleatórios sobre a carteira de investimento de clientes também aleatórios.
- NET Total: patrimônio total do cliente.
- Em seguida temos esse NET segmentado por classes de ativo (Renda Fixa, Fundos Imobiliários, Renda Variável, Fundos, Caixa e Previdência).
Supondo que o perfil desses investidores sugere a seguinte alocação:
- 30% RV
- 20% FII
- 15% Caixa
- 15% RF
- 10% Fundos
- 10% Previdência
Usando a linguagem/ferramenta que preferir, a dinâmica que estamos propondo é a construção de painéis de fácil visualização que mostrem a aderência da carteira destes investidores em relação a sugestão de alocação descrita acima. Como cada assessor conseguiria ver essa informação e o nível de aderência de cada cliente? (baixo, médio, alto)
Prazo de envio até sexta-feira que vem (21/05).
Abraços e boa sorte!!.
Dado o desafio, irei percorrer pelos conceitos básicos das ferramentas utilizadas para a resolução, e então, disponibilizarei o resultado final junto ao código de modelagem de dados.
Metodologia
Como não existe uma referência de classificação de aderência (Bom, Médio e Ruim) para nossa amostra de carteiras, será utilizada a própria amostra de carteiras como referência de aderência. Para isso, o primeiro passo é ordenar a nossa amostra, da carteira mais aderente para a menos aderente, em relação a alocação proposta no desafio.
Para o ordenamento das carteiras, serão utilizados três critérios, e após comparados, um será escolhido.
Os critérios são; Raiz do Erro Quadrático Médio(RMSE), Tracking Error e MAE.
Raiz do Erro Quadrático Médio (RMSE)
RMSE (sigla do inglês Root Mean Square Error) é comumente usada para expressar a acurácia dos resultados numéricos com a vantagem de que RMSE apresenta valores do erro nas mesmas dimensões da variável analisada. A Raiz do Erro Quadrático Médio (RMSE) é definida como:
\(RMSE =\sqrt[]{ \frac{ \sum_{k=1}^{N} { (p_a,_k - p_r,_k)^2}} {N }}\)
Onde:
\(RMSE\) = Raiz do Erro Quadrático Médio;
\(k\) = Classe de Ativo;
\(p_a,_k\) = Percentual alocado no ativo \(k\);
\(p_r,_k\) = Percentual de referência no ativo \(k\);
\(N\) = Número de Classes de Ativo.
Importante ressaltar que um \(RMSE\) baixo é bom pois mostra aderência ao objetivo.
Tracking Rrror
O termo tracking error é bem aceito em inglês, mas traduzi-lo para erro de rastreamento pode ajudar a entender que ele diz respeito à capacidade de um produto financeiro rastrear com perfeição um indicador de referência. A expressão se assemelha a \(RMSE\).
Tracking Error é definido como:
\(TE =\sqrt[]{ \frac{ \sum_{k=1}^{N} { (p_a,_k - p_r,_k)^2}} {N-1}}\)
Onde:
\(TE\) = Tracking error;
\(k\) = Classe de Ativo;
\(p_a,_k\) = Percentual alocado no ativo \(k\);
\(p_r,_k\) = Percentual de referência no ativo \(k\);
\(N\) = Número de Classes de Ativo
Importante ressaltar que um \(TE\) baixo é bom pois mostra aderência ao objetivo.
Erro Absoluto Médio (MAE)
O Erro Absoluto Médio é dado pela seguinte expressão:
\(MAE =\sum_{k=1}^{N} { \frac{ \sqrt[]{(p_a,_k - p_r,_k)^2}} {N}}\)
Onde:
\(MAE\) = Erro Absoluto Médio;
\(k\) = Classe de Ativo;
\(p_a,_k\) = Percentual alocado no ativo \(k\);
\(p_r,_k\) = Percentual de referência no ativo \(k\);
\(N\) = Número de Classes de Ativo
Importante ressaltar que um \(MAE\) baixo é bom pois mostra aderência ao objetivo.
Discução e Resultados
Observando a distribuição dos resultados das três métricas propostas acima, é possível notar uma diferença no ordenamento das carteiras mais aderentes utilizando a métrica \(MAE\), porém, tal diferença nesse caso em específico, não influencia na classificação de Bom, Médio e Ruim.
Já que independente da métrica utilizada obteremos as mesmas classificações para as carteiras, optei por utilizar a métrica \(RSMR\), por ser mais comum na literatura.
Com o recurso do Box-plot mostrado na figura abaixo, podemos notar a presença de três outlines acima do limite superior:
Esses três outlines são carteiras que possuem uma alocação de capital muito diferente da recomendação. São pontos que, para a obtenção de um indicador normalizado e uniforme, iriam interferir negativamente. Sendo assim, para a elaboração do indicador, esses outlines não serão considerados, mas permanecerão na base e serão classificados como “Ruim” além de receber uma indicação de atenção no Dashboard final, como mostra a imagem
Indicador Auxiliar
Como comentado anteriormente, removendo os outlines obtemos a seguinte distribuição:
A Classificação será feita utilizando os intervalos no Box-plot na seguinte maneira; De 0 até o primeiro quartil a classificação é “bom”, do primeiro quartil até o terceiro quartil a classificação é “Médio”, e do terceiro quartil até o limite superior a classificação é “Ruim”.
Ou seja, teremos 25% das carteiras com nível de aderência “Bom”, 50% com aderência “Média” e 25% com aderência “Ruim”.
Mas como o objetivo não é mostrar a distribuição entre as categorias de aderência, é necessária então a normalização da medida do erro, pois assim será possível adequar o indicador para que o mesmo varie entre o intervalo de 0 a 100, sendo 0 o mais aderente. Esse indicador será chamado de Indicador Auxiliar e terá uma distribuição uniforme entre Bom, Médio e Ruim, facilitando assim a interpretação rápida do usuário final.
A seguir a imagem com o termômetro do Indicador Auxiliar que está presente no Dashboard:
Segue o Dashboard final e o código no apêndice.
Apêndice
options(warn=-1)
# IMPORTAÇÃO DE PACOTES
{
# Check if the packages that we need are installed
want = c("readxl", "ggplot2","dplyr","readr")
have = want %in% rownames(installed.packages())
# Install the packages that we miss
if ( any(!have) ) { install.packages( want[!have] ) }
# Load the packages
junk <- lapply(want, library, character.only = T)
# Remove the objects we created
rm(have, want, junk)
}
my_data <- read_excel("C:/Users/pichau/Desktop/Manchester/Processo Seletivo.xlsx")
# Renomea as colunas (substitui espaços por "_")
{
names(my_data) <- gsub(" ","_", names(my_data))
bind_parte_1 = my_data %>% select(., Assessor, Cliente, Net_Renda_Fixa) %>%
mutate(.,Ativo ='Net_Renda_Fixa' ) %>% rename(., Valor = Net_Renda_Fixa )
bind_parte_2 = my_data %>% select(., Assessor, Cliente, Net_Fundos_Imobiliários) %>%
mutate(.,Ativo ='Net_Fundos_Imobiliários' ) %>%
rename(., Valor = Net_Fundos_Imobiliários )
bind_parte_3 = my_data %>% select(., Assessor, Cliente, Net_Renda_Variável) %>%
mutate(.,Ativo ='Net_Renda_Variável' ) %>%
rename(., Valor = Net_Renda_Variável )
bind_parte_4 = my_data %>% select(., Assessor, Cliente, Net_Fundos) %>%
mutate(.,Ativo ='Net_Fundos' ) %>%
rename(., Valor = Net_Fundos )
bind_parte_5 = my_data %>% select(., Assessor, Cliente, Net_Caixa) %>%
mutate(.,Ativo ='Net_Caixa' ) %>%
rename(., Valor = Net_Caixa )
bind_parte_6 = my_data %>% select(., Assessor, Cliente, Net_Previdência) %>%
mutate(.,Ativo ='Net_Previdência' ) %>%
rename(., Valor = Net_Previdência )
df_00_my_data_empilhado = bind_rows(bind_parte_1 ,
bind_parte_2 ,
bind_parte_3 ,
bind_parte_4 ,
bind_parte_5 ,
bind_parte_6)
remove(bind_parte_1 ,
bind_parte_2 ,
bind_parte_3 ,
bind_parte_4 ,
bind_parte_5 ,
bind_parte_6)
df_00_my_data_empilhado$Ativo <- gsub("Net_","", df_00_my_data_empilhado$Ativo)
df_00_my_data_empilhado$Ativo <- gsub("_"," ", df_00_my_data_empilhado$Ativo)
df_00_my_data_empilhado = df_00_my_data_empilhado %>% filter(., !Valor == 0)
}
# 1
# df_01 = Assessor, Cliente, Net_Total, Net_Renda_Fixa,
# Net_Fundos_Imobiliáris, Net_Renda_Variável, Net_Fundos,
# Net_Caixa, Net_Previdência, Percent_Net_Renda_Fixa,
# Percent_Net_Fundos_Imobiliários, Percent_Net_Renda_Variável,
# Percent_Net_Fundos, Percent_Net_Caixa, Percent_Net_Previdência,
# RMSE, TE, Classificação
{
{
df_01 = my_data
# calcula as porcentagens de alocações
{
df_01$Percent_Net_Renda_Fixa = 1-(df_01$Net_Total - df_01$Net_Renda_Fixa )/ df_01$Net_Total
df_01$Percent_Net_Fundos_Imobiliários = 1-(df_01$Net_Total - df_01$Net_Fundos_Imobiliários )/ df_01$Net_Total
df_01$Percent_Net_Renda_Variável = 1-(df_01$Net_Total - df_01$Net_Renda_Variável )/ df_01$Net_Total
df_01$Percent_Net_Fundos = 1-(df_01$Net_Total - df_01$Net_Fundos )/ df_01$Net_Total
df_01$Percent_Net_Caixa = 1-(df_01$Net_Total - df_01$Net_Caixa )/ df_01$Net_Total
df_01$Percent_Net_Previdência = 1-(df_01$Net_Total - df_01$Net_Previdência )/ df_01$Net_Total
}# calcula as porcentagens de alocações
# calcula o Erro quadratico Médio (RMSE) e Tracking Error
df_01 = df_01 %>% mutate(., RMSE = sqrt(( (Percent_Net_Renda_Fixa - 0.15 )^2 +
(Percent_Net_Fundos_Imobiliários - 0.20)^2 +
(Percent_Net_Renda_Variável - 0.30)^2 +
(Percent_Net_Fundos - 0.10)^2 +
(Percent_Net_Caixa - 0.15)^2 +
(Percent_Net_Previdência - 0.10)^2 )/6) ) %>%
mutate(., TE = sqrt( ( (Percent_Net_Renda_Fixa - 0.15 )^2 +
(Percent_Net_Fundos_Imobiliários - 0.20)^2 +
(Percent_Net_Renda_Variável - 0.30)^2 +
(Percent_Net_Fundos - 0.10)^2 +
(Percent_Net_Caixa - 0.15)^2 +
(Percent_Net_Previdência - 0.10)^2 )/ 5 ) ) %>%
mutate(., MAE = ( ( sqrt((Percent_Net_Renda_Fixa - 0.15 )^2) +
sqrt ((Percent_Net_Fundos_Imobiliários - 0.20)^2) +
sqrt ((Percent_Net_Renda_Variável - 0.30)^2) +
sqrt ( (Percent_Net_Fundos - 0.10)^2) +
sqrt( (Percent_Net_Caixa - 0.15)^2) +
sqrt ((Percent_Net_Previdência - 0.10)^2 ) ) / 6 ) ) #%>%
# mutate(., MAPE = ( ( sqrt(((Percent_Net_Renda_Fixa - 0.15 )/0.15)^2) +
#
# sqrt(((Percent_Net_Fundos_Imobiliários - 0.20)/0.2)^2) +
#
# sqrt(((Percent_Net_Renda_Variável - 0.30)/0.3)^2) +
#
# sqrt(((Percent_Net_Fundos - 0.10)/0.10)^2) +
#
# sqrt((Percent_Net_Caixa - 0.15)/0.15) +
#
# sqrt(((Percent_Net_Previdência - 0.10)/0.10)^2) )
#
# / 6 ) )
}
# Box plot Tracking Error
{
ggplot(df_01) +
aes(x = "", y = MAE) +
geom_boxplot(fill = "#6baed6") +
theme_light()
}# Box plot Tracking Error
# Box plot Tracking Error e Erro Quadrático Médioe MAE
{ boxplot(df_01$MAE, df_01$RMSE, df_01$TE,
main = "Multiple boxplots for comparision",
at = c(1,2,3),
names = c("MAE", "RMSE", "TE"),
las = 1,
col = c("orange","red", "blue"),
border = "brown",
horizontal = TRUE,
notch = TRUE
) }# Box plot Tracking Error e Erro Quadrático mé
summary(df_01$RMSE)
summary(df_01$RMSE)["3rd Qu."]
summary(df_01$RMSE)[ "1st Qu."]
Limite_Superior = as.numeric(summary(df_01$RMSE)["3rd Qu."] + 1.5 * ( summary(df_01$RMSE)["3rd Qu."] - summary(df_01$RMSE)[ "1st Qu."]))
Limite_Superior
outlines_df_01 = df_01 %>% filter(., RMSE >Limite_Superior )
df_01_sem_outlines = df_01 %>% filter(., !RMSE >Limite_Superior )
ggplot(df_01_sem_outlines) +
aes(x = "", y = RMSE) +
geom_boxplot(fill = "#6baed6") +
theme_light()
{
# make labels and margins smaller
par(cex=0.7, mai=c(0.1,0.1,0.2,0.1))
RMSE <- df_01_sem_outlines$RMSE
# define area for the histogram
par(fig=c(0.1,0.7,0.3,0.9))
hist(RMSE)
# define area for the boxplot
par(fig=c(0.8,1,0,1), new=TRUE)
boxplot(RMSE)
# define area for the stripchart
par(fig=c(0.1,0.67,0.1,0.25), new=TRUE)
stripchart(RMSE, method="jitter")
}
# Aplica a Classificação de "Bom, Médio e Ruim"
# Analize de adêrencia Consolidada
{
df_01$Classificação = NA
df_01$Índice_aux = NA
for ( i in 1:nrow( df_01) ) {
if (df_01$RMSE[i] >= summary(df_01$RMSE)['3rd Qu.']) {
df_01$Classificação[i] = "Ruim"
df_01$Índice_aux[i] = df_01$Índice_aux[i] =(df_01$RMSE[i] - summary(df_01$RMSE)['3rd Qu.']) / (Limite_Superior - summary(df_01$RMSE)['3rd Qu.']) * 100/3 + 2*100/3
} else if (summary(df_01$RMSE)['1st Qu.'] < df_01$RMSE[i] && df_01$RMSE[i] <= summary(df_01$RMSE)['3rd Qu.']) {
df_01$Classificação[i] = "Médio"
df_01$Índice_aux[i] =(df_01$RMSE[i] - summary(df_01$RMSE)['1st Qu.']) / (summary(df_01$RMSE)['3rd Qu.'] - summary(df_01$RMSE)['1st Qu.']) * 100/3 + 100/3
} else {
df_01$Classificação[i] = "Bom"
df_01$Índice_aux[i] =(df_01$RMSE[i] / summary(df_01$RMSE)['1st Qu.'])*100/3
}
}
}
} # df_01
# 2 Empilhado
# df_02_Valor_Percent_empilhado = "Assessor" "Cliente" "Percentual_alocado" "Valor" "Ativo"
{
bind_parte_1 = df_01 %>% select(.,Assessor,Cliente,Percent_Net_Renda_Fixa, Net_Renda_Fixa) %>%
mutate(.,Ativo ='Net_Renda_Fixa' ) %>%
rename(., Percentual_alocado = Percent_Net_Renda_Fixa )%>%
rename(., Valor = Net_Renda_Fixa)
bind_parte_2 = df_01 %>% select(.,Assessor,Cliente,Percent_Net_Fundos_Imobiliários,Net_Fundos_Imobiliários) %>%
mutate(.,Ativo ='Net_Fundos_Imobiliários' ) %>%
rename(., Percentual_alocado = Percent_Net_Fundos_Imobiliários )%>%
rename(., Valor = Net_Fundos_Imobiliários)
bind_parte_3 = df_01 %>% select(.,Assessor,Cliente,Percent_Net_Renda_Variável,Net_Renda_Variável) %>%
mutate(.,Ativo ='Net_Renda_Variável' ) %>%
rename(., Percentual_alocado = Percent_Net_Renda_Variável )%>%
rename(., Valor = Net_Renda_Variável)
bind_parte_4 = df_01 %>% select(.,Assessor,Cliente,Percent_Net_Fundos, Net_Fundos) %>%
mutate(.,Ativo ='Net_Fundos' ) %>%
rename(., Percentual_alocado = Percent_Net_Fundos )%>%
rename(., Valor = Net_Fundos)
bind_parte_5 = df_01 %>% select(.,Assessor,Cliente,Percent_Net_Caixa, Net_Caixa) %>%
mutate(.,Ativo ='Net_Caixa' ) %>%
rename(., Percentual_alocado = Percent_Net_Caixa )%>%
rename(., Valor = Net_Caixa)
bind_parte_6 = df_01 %>% select(.,Assessor,Cliente,Percent_Net_Previdência, Net_Previdência) %>%
mutate(.,Ativo ='Net_Previdência' ) %>%
rename(., Percentual_alocado = Percent_Net_Previdência ) %>%
rename(., Valor = Net_Previdência)
df_02_Valor_Percent_empilhado = bind_rows(bind_parte_1 ,bind_parte_2 ,bind_parte_3 ,bind_parte_4 ,bind_parte_5 ,bind_parte_6)
remove(bind_parte_1 ,bind_parte_2 ,bind_parte_3 ,bind_parte_4 ,bind_parte_5 ,bind_parte_6)
df_02_Valor_Percent_empilhado$Ativo <- gsub("Net_","", df_02_Valor_Percent_empilhado$Ativo)
df_02_Valor_Percent_empilhado$Ativo <- gsub("_"," ", df_02_Valor_Percent_empilhado$Ativo)
}
# 3 Acessor, Cliente, Aderência(RMSE)
# {
#
# df_03 = df_01 %>% select(., Assessor, Cliente, Net_Total, RMSE )
#
# }
# 4 Referencia
{
# Percentua da distribuição de carteira
# df_04_referencia_Percentual
{
Ativo = c("Net_Renda_Fixa", "Net_Fundos_Imobiliários", "Net_Renda_Variável", "Net_Fundos", "Net_Caixa" , "Net_Previdência" )
Valor = c(0.15 ,0.20 , 0.30, 0.10, 0.15, 0.10)
# Troca _ por espaços
df_04_referencia_Percentual = data.frame(Ativo,Valor)
df_04_referencia_Percentual$Ativo <- gsub("Net_","", df_04_referencia_Percentual$Ativo)
df_04_referencia_Percentual$Ativo <- gsub("_"," ", df_04_referencia_Percentual$Ativo)
}
# Percentua da distribuição de carteira
# df_05_Referencia_Classificacao
{
classificacao = c('Bom', 'Médio', 'Ruim')
RSMS_Start = c(0, summary(df_01$RMSE)['1st Qu.'],summary(df_01$RMSE)['3rd Qu.'])
RSMS_End = c(summary(df_01$RMSE)['1st Qu.'], summary(df_01$RMSE)['3rd Qu.'], Limite_Superior)
df_05_Referencia_Classificacao = data.frame(classificacao, RSMS_Start, RSMS_End)
}
# Nova Escala
{
min = c(0)
midle_min = c(100/3)
midle_max = c(2*100/3)
max = c(100)
nova_escala = data.frame(min,midle_min, midle_max, max)
}
# Troca _ por espaços
names(df_01) <- gsub("_"," ", names(df_01))
names(df_02_Valor_Percent_empilhado) <- gsub("_"," ", names(df_02_Valor_Percent_empilhado))
names(my_data) <- gsub("_"," ", names(my_data))
names(df_05_Referencia_Classificacao) <- gsub("_"," ", names(df_05_Referencia_Classificacao))
names(outlines_df_01) <- gsub("_"," ", names(outlines_df_01))
}