Anexo. 4 Códigos

A continuación preséntase o código utilizado para realizar o procedemento descrito no desenvolvemento do traballo.

Datos

Recollida de datos

O primeiro que se fixo foi cargar a táboa de empresas.

library(readxl)
empresas <- read_excel("data/000_empresas.xlsx")

Despois extraíanse os ticks das empresas.

library(dplyr)
ticks <- empresas |> 
  select(TICKERS) |> 
  pull()

Unha vez almacenados os ticks das empresas na variable ticks, os datos correspondentes a ditas empresas foron descargados de Yahoo Finance mediante o paquete quantmod de Ryan and Ulrich (2023).

library(quantmod)
nombres_colum <- c("Date","Open","High","Low","Close","Volume","Adjusted")
qmd_data <- list()
for (i in 1:length(ticks)) {
  tick <- ticks[i]
  value <- getSymbols(
    tick,
    from = "2000-01-02",
    to = "2023-03-01",
    auto.assign = F,
    periodicity = "monthly") |>
    as.data.frame()
  dates <- row.names(value)
  row.names(value) <- NULL
  value <- cbind(dates,value)
  names(value) <- nombres_colum
  qmd_data[[tick]] <-  value
}

Co obxectivo de realizar unha análise exploratoria dos datos, optouse por realizar unha avaliación visual dos datos históricos do prezo axustado polo que se executou:

lapply(qmd_data, function(x){
  x |>
    ggplot(aes(x=as.Date(Date), y=Adjusted))+
             geom_line(color="#065AD8")
})

Tras a análise visual realizada co fragmento de código anterior detectouse a existencia de prezos constantes, así como cálculos erróneos no prezo axustado correspondente aos primeiros anos dalgunha serie. Para eliminar estas irregularidades, só se seleccionaron aquelas observacións posteriores a xaneiro de 2005.

returns_emps <- qmd_data |>
  lapply(function(x){
    emps <- x |>
      filter(Date >= "2005-01-31")
  })

Para determinar se os datos que foran importados tiñan valores que faltaban, executouse o seguinte código:

na_values <- returns_emps |>
  sapply(function(x){
    na <- length(which(is.na(x)))
  })
emp_con_na <- which(na_values > 0)

Para solucionar o problema de rexistro incorrecto dos datos, optouse por eliminar aqueles que non presentasen variacións de prezo en máis de 10 observacións. Para o cal, os retornos calculáronse primeiro executando o seguinte código, mediante o cal tamén se eliminaron as series con valores ausentes.

returns_emps2 <- returns_emps[-emp_con_na] |>
  lapply(function(x){
    returns <- x |>
      select(Date, Adjusted) |>
      mutate(Return_Ad = Delt(Adjusted)[,1]) |>
      na.omit() |>
      select(Date, Return_Ad)
  })

Unha vez computados os retornos, elimináronse aquelas series que presentaban 0 retornos en máis de 10 observacións, para o que se executou o seguinte código.

zero_values <- returns_emps2 |>
  sapply(function(x){
    zeros <- length(which(x[,2]==0))
  })
returns_emps3 <- returns_emps2[zero_values<10]

Indicadores

A continuación móstrase o código utilizado durante o proceso descrito no subtítulo de indicadores do capítulo 2.

En primeiro lugar, descargáronse os datos do IBEX, calculáronse os rendementos do prezo axustado dos mesmos e seleccionáronse os valores posteriores a xaneiro de 2005.

#Importando IBEX
IBEXsel <- getSymbols(
  "^IBEX",
  from = "1990-01-01",
  to = "2023-03-01",
  auto.assign = F,
  periodicity = "monthly") |>
  as.data.frame()
dates <- row.names(IBEXsel)
row.names(IBEXsel) <- NULL
IBEXsel <- cbind(dates,IBEXsel)
names(IBEXsel) <- nombres_colum
# Cálculo da rendibilidade e selección de observacións despois
# Xaneiro 2005.
IBEXsel <- IBEXsel |>
  mutate(Return_I = Delt(Adjusted)[,1]) |>
  na.omit() |>
  filter(Date >= "2005-01-31") |>
  select(Date, Return_I)

A continuación, engadíronse os valores das rendibilidades do IBEX ás táboas de rendibilidade das accións das empresas seleccionadas, e calculáronse e engadíronse a cada unha das táboas as variables que se enumeran a continuación:

  • Volatilidade da empresa
  • Volatilidade do índice
  • Correlación entre a rendibilidade da empresa e o índice
  • A Beta entre a empresa e o índice
returns_indc <- returns_emps3 |>
  lapply(function(x, ind = IBEXsel){
    emp <- x |>
      left_join(ind) |>
      mutate(
        VE = sqrt(cumsum((Return_Ad - cummean(Return_Ad))^2)/1:length(Return_Ad)),
        VI = sqrt(cumsum((Return_I - cummean(Return_I))^2)/1:length(Return_I)),
        Cor = cumsum((Return_Ad-cummean(Return_Ad))*(Return_I-cummean(Return_I)))/(sqrt(cumsum((Return_Ad-cummean(Return_Ad))^2))*sqrt(cumsum((Return_I-cummean(Return_I))^2)))
      )|>
      na.omit() |>
      mutate(
        Beta = (Cor*VE)/VI
      )
  })

Vectores

A continuación móstrase o código utilizado durante o proceso descrito no subtítulo de vectores do título de modelado do capítulo 2.

O primeiro paso realizado para a execución do proceso explicado no subepígrafe en cuestión foi a creación dunha función que permitise obter as mostras consecutivas para cada serie utilizada. A función que se presenta a continuación, como xa se dixo, permite obter as mostras consecutivas dunha serie, para as que se utilizan os parámetros mencionados no subtítulo, número de observacións de entrada e número de observacións de saída, así como un parámetro condicional co que se indícase se o vector que se vai crear é de entrada ou de saída.

vector2dmaker <- function(vec, ent, sal, eos=T){
  if(eos==T){
    emp <- 1
    term <- (length(vec) - (ent+sal-1))
    ob <- ent
  }else{
    emp <- ent + 1
    term <- (length(vec)-sal+1)
    ob <- sal
  }
  
  vec2d <- sapply(emp:term,
               function(x) vec[x:(x + ob-1)]) |>
    matrix(nrow = ob) |>
    t()
  
  return(vec2d)
}

A continuación móstrase o código utilizado para crear os vectores de entrada correspondentes a cada unha das series. Para o cal se crearon primeiro dúas funcións, unha para as entradas e outra para as saídas.

# Función que se utilizará para crear as entradas tridimensionais
input3dmaker <- function(x,inp,out){
  empre <- x
  series <- 2:dim(x)[2]
  for (i in series) {
    if(i==series[1]){
      vec3d <- vector2dmaker(empre[[i]],ent=inp,sal=out)
    }else{
      vec3d <- abind(vec3d,vector2dmaker(empre[[i]],ent=inp,sal=out), along = 3)
    }
  }
  return(vec3d)
}

# Función que se utilizará para crear as saídas tridimensionais
output3dmaker <- function(x,inp,out){
  empre <- x[["Return_Ad"]]
  vec3d <- vector2dmaker(empre,ent=inp,sal=out,F)
  dim(vec3d) <- c(dim(vec3d),1)
  return(vec3d)
}

Despois creáronse as listas de vectores tridimensionais de entradas e saídas por empresa, executando outras dúas veces o seguinte código co obxectivo de crear as listas vecs3d2e e vecs3d3e que se corresponden con aqueles casos nos que foron 2 e 3 entradas. seleccionados.

# O horizonte temporal está definido
ht <- 1

# Defínense as observacións de entrada
oe <- 1

# Os vectores de entrada 3D créanse para o tamaño de entrada 1
vecs3d1e <- list()
for(i in 1:length(returns_indc)){
  emp <- returns_indc[[i]]
  inps <- input3dmaker(emp, oe, ht)
  outs <- output3dmaker(emp, oe, ht)
  dates <- emp[(oe + ht):dim(emp)[1],1]
  id <- rep(names(returns_indc)[i],length(dates))
  tibblex <- tibble(
    Date = dates,
    ID = id,
    inputs = inps,
    outputs = outs
  )
  vecs3d1e[[names(returns_indc)[i]]] <- tibblex
}

Modelado e formación

A continuación preséntase o código utilizado durante o proceso descrito nas diferentes subseccións da sección Modelado e formación.

Modelado

Para a creación dos modelos, o primeiro paso a executar é obter a información dos vectores para os que se vai construír o modelo, o que se fixo executando o seguinte código:

data <- bind_rows(vecs3d1e)
data <- data  |>
  arrange(Date)
inputsinfo <- data|>
  select(inputs) |>
  pull() |>
  dim()
outputsinfo <- data|>
  select(outputs) |>
  pull() |>
  dim()

# Definir parámetros
n_ob_pas <- inputsinfo[2]
n_variables <- inputsinfo[3]
n_ob_fut <- outputsinfo[2]

Despois constituíuse a estrutura dos modelos cos aspectos descritos en 2.5.1 Modelado.

# Capa de entrada
inp <- layer_input(
  shape = c(NULL,n_ob_pas,n_variables))

# Capas ocultas
# - CNN
cnn <- inp |>
  layer_conv_1d(
    filters = 64,
    kernel_size = 1,
    activation = layer_activation_leaky_relu())
# - LSTM
lstm <- cnn |>
  layer_lstm(64)

# Capa de Salida
out <- lstm |> 
  layer_dense(
    n_ob_fut*1)

# Unir as capas para constituír o modelo
model <- keras_model(inp, out)
# Establecemento de parámetros de aprendizaxe
model |> 
  compile(loss = "$MSE$", optimizer = optimizer_sgd(0.0005))
Nota

Podes atopar modelos non adestrados no cartafol data do repositorio onde se atopa este traballo. Os modelos gardáronse usando a extensión hdf5 e baixo os nomes model1e, model2e e model3e.

Formación

O primeiro paso é definir a función a utilizar para adestrar os modelos. Esta función creouse co obxectivo de utilizar o método de adestramento descrito en 2.5.2 Formación. Como resultado, esta función devolverá unha lista que conterá as predicións obtidas e o modelo despois de ter sido adestrado e tomará como entradas principais o tibble denominado datos constituído no primeiro paso que se expón en no apartado Modelado deste anexo e o modelo tamén doutros argumentos que permitan o uso da función con algunhas entradas principais que non se utilizan no presente traballo.

wfv_train <- function(x, modelo, seq_var_name, inp_var_name = "inputs", out_var_name = "outputs", progress_bar=T){
  
  predictions <- c()
  seq_val <- unique(x[[seq_var_name]])
  
  if(progress_bar){
    pb <- txtProgressBar(min = 0, max = length(seq_val), initial = 0, style = 3)
  }
  
  
  # Iteración que se executará para cada valor único na variable que define a secuencia de datos. Por este motivo é de vital importancia que os datos en tibble x estean ordenados pola variable de secuencia cuxo nome se pasa a seq_var_name
  
  for (i in 1:length(seq_val)) {
    val_seq <- seq_val[i]
    # Extraer entradas e saídas correspondentes ao período na variable secuencia actual
    inputs <- x |>
      filter(!!sym(seq_var_name) == val_seq) |>
      select(!!sym(inp_var_name)) |>
      pull()
    outputs <- x |>
      filter(!!sym(seq_var_name) == val_seq) |>
      select(!!sym(out_var_name)) |>
      pull()
    outputs <- outputs[,,1]
    
    # Use entradas para obter previsións para todos os períodos da variable secuencia excepto o primeiro
    if(i > 1){
      pred <- modelo |>
        predict(inputs, verbose = 3)
      predictions <- rbind(predictions, pred)
    }
    
    # Adestrar o modelo
    modelo |>
      fit(
        inputs,
        outputs,
        epochs = 1,
        batch_size = 10,
        shuffle = F,
        verbose = 0)
    
    if(progress_bar){
      setTxtProgressBar(pb,i)
      }
    
  }
  
  if(progress_bar){
    close(pb)
  }
  
  results <- list()
  results[['predicciones']] <- predictions
  results[['modelo']] <- modelo
  return(results)
}

Unha vez creada a función, obtivéronse as predicións mediante o seguinte código:

resultados <- wfv_train(data,model,'Date')
predicciones1e <- resultados$predicciones
Nota

Podes atopar modelos adestrados no cartafol data do repositorio onde se atopa este traballo. Os modelos gardáronse usando a extensión hdf5 e baixo os nomes model1etd, model2etd e model3etd.

Segundo se explica en 2.6.1 Predicións, ademais das predicións obtidas polos modelos, calculáronse predicións obtidas a partir do uso da media aritmética, para comparar coas obtidas cos modelos. Para calcular estas predicións, creouse a seguinte función:

wfv_means <- function(x, seq_var_name, inp_var_name = "inputs", out_var_name = "outputs", id_var_name, progress_bar=T){
  
  means <- c()
  seq_val <- unique(x[[seq_var_name]])
  
  if(progress_bar){
    pb <- txtProgressBar(min = 0, max = length(seq_val), initial = 0, style = 3)
  }
  
  for (i in 1:length(seq_val)) {
    val_seq <- seq_val[i]
    inputs <- x |>
      filter(!!sym(seq_var_name) == val_seq) |>
      select(!!sym(inp_var_name)) |>
      pull()
    inputspred <- x |>
      filter(!!sym(seq_var_name) == val_seq) |>
      select(!!sym(inp_var_name)) |>
      pull()
    outputs <- x |>
      filter(!!sym(seq_var_name) == val_seq) |>
      select(!!sym(out_var_name)) |>
      pull()
    outputs <- outputs[,,1]
    
    ids <- x |>
      filter(!!sym(seq_var_name) == val_seq) |>
      select(!!sym(id_var_name)) |>
      pull()
    
    if(i==1){
      dfmeans <- inputs[,,1] |>
        as.data.frame() |>
        cbind(ID = ids)
    }else{
      dfmeansupd <- inputs[,dim(inputs)[2],1] |>
        as.data.frame() |>
        cbind(ID = ids)
      names(dfmeansupd)[1] <- paste0("V",(dim(dfmeans)[2]))
      idsdf <- unique(c(ids, dfmeans[[id_var_name]]))
      idsdf <- data.frame(ID = idsdf)
      dfmeansupd <- dplyr::left_join(idsdf, dfmeansupd, by = "ID")
      ifelse(
        dim(dfmeansupd)[1] > dim(dfmeans)[1],
        dfmeans <- dplyr::left_join(dfmeansupd, dfmeans, by = "ID"),
        dfmeans <- dplyr::left_join(dfmeans, dfmeansupd, by = "ID")
        )
    }
    
    if(i > 1){
      MEANS <-  dfmeans |>
        rowwise() |>
        mutate(
          means = mean(c_across(-!!sym(id_var_name)), na.rm = T)) |>
        slice(match(ids,!!sym(id_var_name))) |>
        pull(means) |>
        as.matrix()
      means <- rbind(means, MEANS)
    }
    
    if(progress_bar){
      setTxtProgressBar(pb,i)
    }
    
  }
  
  if(progress_bar){
    close(pb)
  }
  
  return(means)
}

Unha vez creada a función, obtivéronse as predicións mediante o seguinte código:

meanse1 <- wfv_train(data,'Date',id_var_name = "ID")
Nota

Ademais do exposto anteriormente, no ficheiro .Rprofile do repositorio no que se atopa este traballo creáronse dúas funcións getconfig e plot_modelk que permiten representar gráficamente a estrutura dos modelos mediante o paquete Iannone (2023), como visto nas Figura 17. O código a usar sería:

# As funcións créanse para representar gráficamente as estruturas utilizadas neste traballo.
model |>
  getconfig() |>
  plot_modelk() |>
  grViz()

Repetiuse o procedemento exposto nas seccións Modelado e Formación deste anexo para construír os 10 modelos feitos a partir de cada grupo de vectores tridimensionais, substituíndo a chamada a vecs3d1e por no primeiro código exposto. .vecs3d2e e vecs3d3e, dependendo do grupo de vectores tridimensionais utilizados.

Resultado

A continuación preséntase o código utilizado durante o proceso descrito nas diferentes subseccións da sección de Resultados.

Predicións

A análise exposta en 2.6.1 Predicións realizouse a partir de gráficos (ver Figura 8, Figura 9 e Figura 10), nos que se recollen os valores dos indicadores \(MSE\) e \(R^2\) para cada unha das estruturas ensaiadas.

O primeiro paso para obter estas gráficas foi o cálculo dos indicadores, para cada período de tempo, para cada unha das predicións obtidas a partir dos distintos modelos construídos con cada estrutura. Isto faise usando o seguinte código.

# Extraer os resultados reais
salidas <- data |>
  filter(
    Date > data$Date[1]
  ) |>
  select(outputs) |>
  pull()
salidas <- salidas[,,1]

# Calcular os indicadores MSE e R2
indicadores <- data |>
  filter(Date > data$Date[1]) |>
  cbind(predicciones = predicciones1e[,1]) |>
  cbind(means = meanse1) |>
  mutate(salidas = salidas) |>
  select(Date, predicciones, means, salidas) |>
  group_by(Date) |>
  summarise(
    r2 = 1 - (sum((salidas - predicciones)^2)/sum((salidas - means)^2)),
    mse = mse(predicciones, salidas),
  )

Os diferentes indicadores calculados para cada un dos 10 modelos adestrados con cada unha das estruturas foron almacenados nunha lista denominada list_indicadores. Isto faise usando o seguinte código:

list_indicadores[["indicadores1"]] <-  indicadores

Feito isto, obtense unha lista que contén 10 marcos de datos (indicadores1,…,indicadores10), que á súa vez conteñen os valores dos de \(MSE\) e \(R^2\) das predicións obtidas. por modelos de ARN para cada unha das empresas agrupadas por data. Entón, a gráfica foi construída usando o seguinte código.

# Agrupar a información das distintas construcións nun único marco de datos
indi_graf_data <- do.call(cbind,list_indicadores)

# Obter os resultados medios, para cada período de tempo, utilizando as distintas construcións
indi_graf_data |>
  rowwise() |>
  mutate(
    Date = `indicadores1.Date`,
    meanmse = mean(c_across(contains("mse"))),
    meanr2 = mean(c_across(contains("r2")))
    ) |>
  select(
    Date, meanmse,meanr2
  )|>
  # Gráfico
  mutate(
    Date = as.Date(Date)) |>
  ggplot(aes(x = Date, group = 1)) +
  geom_line(aes(y = meanmse, color = "MSE")) +
  geom_line(aes(y = meanr2, color = "R2")) +
  scale_color_manual(values = c("blue", "green")) +
  theme(axis.text.x = element_text(angle = 90)) +
  labs(x = "Fecha", y = "Indicadores", color = "Indicadores")

Ademais das gráficas, na análise dos resultados tamén se utilizou o Táboa 4, nos que se sitúan as empresas que obtiveron os mellores e peores indicadores para cada estrutura Para a obtención destes datos utilizouse o seguinte código:

indicadores_X_emp <- data |>
  filter(Date > data$Date[1]) |>
  cbind(predicciones = predicciones1e[,1]) |>
  cbind(means = meanse1) |>
  mutate(salidas = salidas) |>
  select(Date, predicciones, means, salidas, ID) |>
  group_by(ID) |>
  summarise(
    r2 = 1 - (sum((salidas - predicciones)^2)/sum((salidas - means)^2)),
    mse = mse(predicciones, salidas)
  ) |>
  select(ID, r2, mse)

Do mesmo xeito que os indicadores calculados por data, para gardar os indicadores calculados por empresa, creouse unha lista chamada list_indic_emp. Despois de ter almacenados os 10 marcos de datos indicadores por empresa na lista, extraéronse as empresas con mellores e peores resultados mediante o seguinte código:

# Agrupar a información das distintas construcións nun único marco de datos
ind_emp_t <- do.call(rbind, list_indic_emp)

# Calcula a media R2 e MSE por empresa
ind_emp_t <- ind_emp_t |>
  group_by(ID) |>
  summarize(
    r2 = mean(r2),
    mse= mean(mse)) |>
  ungroup() |>
  arrange(desc(r2))

# Obtén as 10 empresas cos mellores e peores indicadores
mejores10 <- head(ind_emp_t,10)
peores10 <- tail(ind_emp_t,10)

E usando as variables anteriores e as funcións rbind() e cbind, creouse a Táboa 4.

Composición de carteiras

Neste apartado explícase como se realizou a análise da comparación dos resultados obtidos polas diferentes carteiras (ver Figura 11, Figura 12 e Figura 13). Para iso, primeiro cómpre obter a composición das carteiras, por datas, a partir das predicións obtidas mediante a utilización das medias aritméticas e dos modelos de ARN.

Para calcular a composición das carteiras utilizouse o paquete R Berwin A. Turlach R port by Andreas Weingessel <Andreas.Weingessel@ci.tuwien.ac.at> Fortran contributions from Cleve Moler dpodi/LINPACK) (2019). A continuación móstrase o código utilizado para atopar a composición das carteiras a partir das predicións da media:

# Creouse un marco de datos no que se almacenaba toda a información:
#   - Valores IBEX, como índice de referencia
#   - Valores das predicións, tanto os obtidos polo modelo de ARN como polas medias aritméticas

DATA <- data |>
  left_join(IBEXsel, by ="Date") |>
  mutate(IBEX = Return_I) |>
  arrange(Date) |>
  filter(
    Date > data$Date[1]
  ) |>
  mutate(predicciones = predicciones1e[,1]) |>
  mutate(
    Real = salidas,
    RNA = predicciones,
    Means = meanse1
  ) |>
  select(Date, Real, IBEX, RNA, Means, ID)

# A partir do marco de datos creáronse DATA:
#    - Un marco de datos cuxas columnas son os datos reais de cada unha das empresas para cada un dos períodos de tempo para os que se obtiveron predicións.
#    - Un marco de datos cuxas columnas son os datos obtidos mediante a utilización das medias aritméticas de cada unha das empresas para cada un dos períodos de tempo para os que se obtiveron predicións.

pvtReal <- DATA |>
  select(Date, Real, ID) |>
  pivot_wider(
    names_from = ID,
    values_from = Real
  )

pvtMeans <- DATA |>
  select(Date, Means, ID) |>
  pivot_wider(
    names_from = ID,
    values_from = Means
  )

# Creouse o marco de datos no que se almacenaba a composición das carteiras para cada un dos períodos para os que se obtivo a predición
weightsm <- data.frame()

# Iteración pola que se atopa a composición das carteiras

pb <- txtProgressBar(min = 0, max = length(unique(data$Date)[-1]), initial = 0, style = 3)

for (i in 1:length(unique(data$Date)[-1])) {
  if(i>1){
    
    # Créase o marco de datos que inclúe os datos a utilizar para atopar a composición da carteira, esta é creada polos datos reais ata a data e a previsión para o próximo período
    
    datamQP <- pvtReal |>
      filter(Date < unique(data$Date)[-1][i]) |>
      rbind(pvtMeans |>
              filter(Date == unique(data$Date)[-1][i])
      )
    
    # Elimina aquelas empresas que non teñan datos reais ou previstos
    
    nare <- which(is.na(datamQP[dim(datamQP)[1],]))
    naremo <- which(is.na(datamQP[(dim(datamQP)[1]-1),]))
    nare <- c(nare,naremo)
    nare <- unique(nare)
    if(length(nare) != 0){
      carteram <- datamQP[, - nare]
    }else{
      carteram <- datamQP
    }
    
    # Extraer previsións
    returnm <- carteram[dim(carteram)[1], -1] |>
      as.matrix() |>
      t()
    
    # Calcula a matriz de covarianza
    
    covmm <- cov(carteram[, -1], use = "complete.obs")
    npcovmm <- nearPD(covmm)$mat |> 
      as.matrix()
    
    # Extrae o número de empresas
    n <- ncol(npcovmm)
    
    # Busca a composición da carteira
    qp_outm <- solve.QP(
      Dmat = 2*npcovmm,
      dvec = rep(0,n),
      Amat = cbind(-1, diag(n)),
      bvec = c(-1, rep(0,n)),
      meq = 1)
    qp_outm <- qp_outm$solution
    qp_outm <- floor(qp_outm*100)/100
    for(j in 1:length(qp_outm)){
      if(qp_outm[j] < 0.001){
        qp_outm[j] <- 0
      }else{}
    }
    
    # Gardar a composición da carteira
    names(qp_outm) <- names(carteram[, -1])
    weightsm <- bind_rows(weightsm, qp_outm)
  }
  
  setTxtProgressBar(pb,i)
}

close(pb)

# Substitúe os pesos reais e as observacións polos valores que faltan por cero

pvtReal[is.na(pvtReal)] <- 0
weightsm[is.na(weightsm)] <- 0

Despois, para atopar a rendibilidade da carteira, multiplicáronse as composicións polos rendementos reais, supouse que se investiu unha no primeiro período e realizouse unha suma acumulada ao longo dos valores para obter o comportamento da rendibilidade ao longo do período do tempo.

# Atopar os rendementos das carteiras formadas a partir das predicións da media aritmética

return_CM <-  weightsm * pvtReal[-1,-1]
return_CM <- rowSums(return_CM)
return_CM <- c(1,return_CM)
return_CM <- data.frame(
  Date = pvtReal[,1],
  Mean = return_CM
)

Realizáronse os mesmos pasos que se realizaron para atopar o comportamento da rendibilidade das carteiras a partir das medias aritméticas para atopar o comportamento a partir das predicións obtidas polo modelo de ARN tal e como se ve no código a continuación.

# A partir do marco de datos DATA creouse un marco de datos cuxas columnas son os datos obtidos mediante o uso do modelo de ARN de cada unha das empresas para cada un dos períodos de tempo para os que se obtiveron predicións.

pvtRNA <- DATA |>
  select(Date, RNA, ID) |>
  pivot_wider(
    names_from = ID,
    values_from = RNA
  )

# Creouse o marco de datos no que se almacenaba a composición das carteiras para cada un dos períodos para os que se obtivo a predición.

weightse <- data.frame()

# Iteración pola que se atopa a composición das carteiras

pb <- txtProgressBar(min = 0, max = length(unique(data$Date)[-1]), initial = 0, style = 3)

for (i in 1:length(unique(data$Date)[-1])) {
  if(i>1){
    
    # Créase o marco de datos que inclúe os datos a utilizar para atopar a composición da carteira, esta é creada polos datos reais ata a data e a previsión para o próximo período.
    
    dataeQP <- pvtReal |>
      filter(Date < unique(data$Date)[-1][i]) |>
      rbind(pvtRNA |>
              filter(Date == unique(data$Date)[-1][-1][i])
            )
    # Elimina aquelas empresas que non teñan datos reais ou previstos
    
    nare <- which(is.na(dataeQP[dim(dataeQP)[1],]))
    naremo <- which(is.na(dataeQP[(dim(dataeQP)[1]-1),]))
    nare <- c(nare,naremo)
    nare <- unique(nare)
    if(length(nare) != 0){
      carterae <- dataeQP[, - nare]
    }else{
      carterae <- dataeQP
    }
    
    # Extraer previsións
    
    returne <- carterae[dim(carterae)[1], -1] |>
      as.matrix() |>
      t()
    
    # Calcula a matriz de covarianza
    
    covme <- cov(carterae[, -1], use = "complete.obs")
    npcovme <- nearPD(covme)$mat |> 
      as.matrix()
    
    # Extrae o número de empresas
    
    n <- ncol(npcovme)
    
    # Busca a composición da carteira
    
    qp_oute <- solve.QP(
      Dmat = 2*npcovme,
      dvec = rep(0,n),
      Amat = cbind(-1, diag(n)),
      bvec = c(-1, rep(0,n)),
      meq = 1)
    qp_oute <- qp_oute$solution
    qp_oute <- floor(qp_oute*100)/100
    for(j in 1:length(qp_oute)){
      if(qp_oute[j] < 0.001){
        qp_oute[j] <- 0
      }else{}
    }
    
    # Gardar a composición da carteira
    
    names(qp_oute) <- names(carterae[, -1])
    weightse <- bind_rows(weightse, qp_oute)
  }
  
  setTxtProgressBar(pb,i)
}

close(pb)

# Substitúe os pesos cos valores que faltan por cero

weightse[is.na(weightse)] <- 0

Despois, para atopar a rendibilidade da carteira, multiplicáronse as composicións polos rendementos reais, supouse que se investiu unha no primeiro período e realizouse unha suma acumulada ao longo dos valores para obter o comportamento da rendibilidade ao longo do período. período.tempo.

# Atopar os rendementos das carteiras formadas a partir das predicións do modelo de ARN

return_CRNA <-  weightse * pvtReal[-1,-1]
return_CRNA <- rowSums(return_CRNA)
return_CRNA <- c(1,return_CRNA)
return_CRNA <- data.frame(
  Date = pvtReal[,1],
  RNA = return_CRNA
)

Despois, ao igual que cos indicadores, creouse unha lista list_ret_RNA na que se almacenaban os marcos de datos dos distintos modelos construídos con cada unha das estruturas. Despois executouse o seguinte código para obter o gráfico.

# Coñecer o comportamento das rendibilidades do IBEX para o período

IBEXvals <- IBEXsel |>
    filter(Date > unique(data$Date)[2]) |>
    select(2) |>
    pull()
IBEXvals <- c(1, IBEXvals)

data_rent_RNA <- do.call(cbind,list_ret_RNA)
data_rent_RNA <- data_rent_RNA |>
  mutate(
    Date = RNA1.Date,
    IBEX = IBEXvals,
    Means = return_CM$Mean) |>
  mutate_at(vars(contains(".RNA")), ~ cumsum(.)) |>
  mutate(
    IBEX = cumsum(IBEX),
    Means = cumsum(Means)) |>
  group_by(Date) |>
  summarize(
    meanRNA = mean(c_across(contains(".RNA"))),
    max_y = max(c_across(contains(".RNA"))),
    min_y = min(c_across(contains(".RNA"))),
    min_5 = unname(quantile(c_across(contains(".RNA")),0.05)),
    max_95 = unname(quantile(c_across(contains(".RNA")),0.95)),
    IBEX = IBEX,
    Means = Means)
data_rent_RNA |>
  mutate(
    Date = as.Date(Date)) |>
ggplot(aes(x = Date)) +
  geom_ribbon(aes(ymin = min_y, ymax = min_5), fill = "blue", alpha = 0.3) +
  geom_ribbon(aes(ymin = max_y, ymax = max_95), fill = "blue", alpha = 0.3) +
  geom_ribbon(aes(ymin = min_5, ymax = max_95), fill = "blue", alpha = 0.6) +
  geom_line(
    aes(y = meanRNA, color = "Media RNA1"),
    linetype = "dashed") +
  geom_line(aes(y = max_y), color = "blue") +
  geom_line(aes(y = min_y), color = "blue") +
  geom_line(aes(y = max_95), color = "blue") +
  geom_line(aes(y = min_5, color = "RNA1")) +
  geom_line(aes(y = IBEX, color = "IBEX")) +
  geom_line(aes(y = Means, color = "Medias")) +
  scale_color_manual(
    values = c(
      "Media RNA1"="blue",
      "RNA1" = "blue",
      "IBEX" = "red",
      "Medias" = "green")) +
  guides(
    color = guide_legend(
      override.aes = list(
        linetype = c("solid","dashed","solid","solid"))))+
  labs(x = "Fecha",
       y = "Rentabilidades",
       color = "Leyenda")+
  theme_minimal()