Skip to content
Snippets Groups Projects
Commit 5071b37a authored by victarr's avatar victarr
Browse files

Upload New File

parent 4987b63d
No related branches found
No related tags found
No related merge requests found
Show whitespace changes
Inline Side-by-side
code/shiny-apps/regresion_indices/server.R 0 → 100644
+ 1749
− 0
View file @ 5071b37a
library(shinydashboard)
library(plotly)
library(tidyverse)
library(tidyquant)
library(reshape2)
library(tidymodels)
library(rAMPL)
options(scipen=999)
server <- function(session, input, output) {
cont <- reactiveValues()
observeEvent(input$empresas1,{
updateSliderInput(session, inputId = "cota_superior", min = round(100/input$cardinalidad_valores, 2))
updateSliderInput(session, inputId = "cota_inferior", max = round(100/input$cardinalidad_valores, 2))
updateSliderInput(session, inputId = "cardinalidad_valores", max = length(input$empresas1), value = length(input$empresas1))
})
observeEvent(input$empresas2,{
updateSliderInput(session, inputId = "cota_superior", min = round(100/input$cardinalidad_valores, 2))
updateSliderInput(session, inputId = "cota_inferior", max = round(100/input$cardinalidad_valores, 2))
updateSliderInput(session, inputId = "cardinalidad_valores", max = length(input$empresas2), value = length(input$empresas2))
})
observeEvent(input$empresas3,{
updateSliderInput(session, inputId = "cota_superior", min = round(100/input$cardinalidad_valores, 2))
updateSliderInput(session, inputId = "cota_inferior", max = round(100/input$cardinalidad_valores, 2))
updateSliderInput(session, inputId = "cardinalidad_valores", max = length(input$empresas3), value = length(input$empresas3))
})
observeEvent(input$empresas4,{
updateSliderInput(session, inputId = "cota_superior", min = round(100/input$cardinalidad_valores, 2))
updateSliderInput(session, inputId = "cota_inferior", max = round(100/input$cardinalidad_valores, 2))
updateSliderInput(session, inputId = "cardinalidad_valores", max = length(input$empresas4), value = length(input$empresas4))
})
observeEvent(input$cardinalidad_valores,{
updateSliderInput(session, inputId = "cota_superior", min = round(100/input$cardinalidad_valores, 2))
updateSliderInput(session, inputId = "cota_inferior", max = round(100/input$cardinalidad_valores, 2))
})
observeEvent(input$indice,{
if(input$indice == "S&P 500"){
load("../../RData/activos.RData")
activos <- activos[5:506,]
updateSelectInput(session,"empresas1", "Seleccione un valor", activos$activo, selected = activos$activo[1])
}
if(input$indice == "NASDAQ 100"){
load("../../RData/activos.RData")
activos <- activos[542:639,]
updateSelectInput(session,"empresas2", "Seleccione un valor", activos$activo, selected = activos$activo[1])
}
if(input$indice == "IBEX 35"){
load("../../RData/activos.RData")
activos <- activos[507:541,]
updateSelectInput(session,"empresas3", "Seleccioneun valor", activos$activo, selected = activos$activo[1])
}
if(input$indice == "EURO STOXX 50"){
load("../../RData/activos.RData")
activos <- activos[640:689,]
updateSelectInput(session,"empresas4", "Seleccione un valor", activos$activo, selected = activos$activo[1])
}
})
####################################
# EJECUCION MODELOS
####################################
env <- new(Environment, "/opt/ampl.linux-intel64/")
ampl <- new(AMPL, env)
# Modelo basico - maximizacion del rendimiento
Data_max <- reactive({
if(input$indice == "S&P 500"){
load("../../RData/activos.RData")
activos <- activos[5:506,]
updateSelectInput(session,"empresas1", "Seleccione un valor", activos$activo, selected = activos$activo[1])
}
if(input$indice == "NASDAQ 100"){
load("../../RData/activos.RData")
activos <- activos[542:639,]
updateSelectInput(session,"empresas2", "Seleccione un valor", activos$activo, selected = activos$activo[1])
}
if(input$indice == "IBEX 35"){
load("../../RData/activos.RData")
activos <- activos[507:541,]
updateSelectInput(session,"empresas3", "Seleccioneun valor", activos$activo, selected = activos$activo[1])
}
if(input$indice == "EURO STOXX 50"){
load("../../RData/activos.RData")
activos <- activos[640:689,]
updateSelectInput(session,"empresas4", "Seleccione un valor", activos$activo, selected = activos$activo[1])
}
# Datos
valores <- NULL
if(input$indice == "S&P 500"){
empresas <- input$empresas1
}
if(input$indice == "NASDAQ 100"){
empresas <- input$empresas2
}
if(input$indice == "IBEX 35"){
empresas <- input$empresas3
}
if(input$indice == "EURO STOXX 50"){
empresas <- input$empresas4
}
for(i in 1:length(empresas)){
valores <- c(valores, activos$simbolo[activos$activo == empresas[i]][1])
}
datos <- NULL
minDim <- 999999
for(i in 1:length(valores)){
Sys.sleep(1)
aux <- getSymbols(valores[i], from = input$date_range[1],
to = input$date_range[2], warnings = FALSE, auto.assign = FALSE)
naux <- names(aux)[6]
names(aux) <- c("open", "high", "low", "close", "volume", "adjusted")
if(length(aux$adjusted) < minDim){
minDim <- length(aux$adjusted)
}
}
for(i in 1:length(valores)){
Sys.sleep(1)
aux <- tail(getSymbols(valores[i], from = input$date_range[1],
to = input$date_range[2], warnings = FALSE, auto.assign = FALSE), n = minDim)
naux <- names(aux)[6]
names(aux) <- c("open", "high", "low", "close", "volume", "adjusted")
datos <- cbind(datos, aux$adjusted)
names(datos)[dim(datos)[2]] <- naux
}
datos <- as.data.frame(datos)
# Eliminar valores na generados como fruto de mezclar valores que pueden haber
# cotizado en diferentes dias al ser de mercados diferentes y que se produzca el
# caso de que un valor un dia no ha cotizado y otros valores si lo han hecho
datos <- drop_na(datos)
rownames(datos) <- gsub("\\.", "-", unlist(gsub("X", "", rownames(datos))))
# Valores que utilizamos (retornos).
returns <- 1 + Return.calculate(datos)
returns <- returns[-1,]
# Preparacion para AMPL (formato de codigo apto para AMPL)
A <- names(datos)
A <- gsub("=", ".", A)
str_sub(A, -9) <- ""
A <- str_c(A, collapse = " ")
a <- str_c("set A :=\n", A, ";", sep = "")
b <- str_c("param R:\n", A, " :=\n", sep = "")
dat <- str_c(a, b, sep = "\n")
data.ampl <- cbind(seq(1, dim(returns)[1]), returns)
c <- apply(data.ampl, 2, str_c, sep = "")
c <- apply(c, 1, str_c, collapse = " ")
c <- str_c(c, collapse = "\n")
dat <- str_c(dat, c, collapse = "\n")
dat <- str_c(dat, ";", collapse = "\n")
dias <- seq(1, dim(returns)[1])
a <- str_c("set T := {1..", dim(returns)[1],"};", sep = "")
n <- input$cardinalidad_valores
d <- "subject to num_empresas:"
e <- str_c(d, "sum{j in A} y[j] <=", collapse = "\n")
e <- str_c(e, n, collapse = " ")
e <- str_c(e, ";", collapse = "")
e2 <- str_c(d, "sum{j in A} y[j] =", collapse = "\n")
e2 <- str_c(e2, n, collapse = " ")
e2 <- str_c(e2, ";", collapse = "")
f <- str_c("subject to cota_inferior {j in A}: ",input$cota_inferior/100,"*y[j]<=x[j];", collapse = "")
g <- str_c("subject to cota_superior {j in A}: x[j]<=",input$cota_superior/100,"*y[j];data;", collapse = "")
p <- input$discount
h <- str_c("param mean {j in A}:= ( sum{i in T}",p,"^(card(T) - i) * R[i,j])/( sum {i in T}",p,"^(card(T) - i));",collapse = "")
#########
# AMPL
#########
ampl$eval("# Objective: convex quadratic
# Constraints: linear
reset;
set A;")
ampl$eval(a)
b <- str_c("param s_max default ", input$max_riesgo, ";", sep = "")
ampl$eval(b)
ampl$eval("param R {T,A};")
if(input$rentabilidad == "Media"){
ampl$eval("param mean {j in A}
:= ( sum{i in T} R[i,j] )/card(T);")
}else{
ampl$eval(h)
}
ampl$eval("param Rtilde {i in T, j in A}
:= R[i,j] - mean[j];
param Cov {j in A, k in A}
:= sum {i in T} (Rtilde[i,j]*Rtilde[i,k]) / card(T);
param Corr {j in A, k in A}
:= Cov[j,k]/sqrt(Cov[j,j]*Cov[k,k]);
var x{A} >=0;
var y{A} binary;
minimize reward: - sum{j in A} mean[j]*x[j] ;
subject to risk_bound:
sum{i in T} (sum{j in A} Rtilde[i,j]*x[j])^2 / card{T} <= s_max;
subject to tot_mass:
sum{j in A} x[j] = 1;")
# Maximo invertir en n empresas
if(input$cota_inferior != 0){
ampl$eval(e2)
}
else{
ampl$eval(e)
}
# Minimo un % en cada una
ampl$eval(f)
# Maximo un % en cada una
ampl$eval(g)
ampl$eval(dat)
ampl$eval("# solver cplex
option solver cplex;
# sharpe:= (sum{i in A} x[i]*mean[i])
")
# Resolver modelo de optimizacion
ampl$solve()
ampl$eval("var media = sum{j in A} mean[j]*x[j];")
ampl$eval("var varianza = sum{i in T} (sum{j in A} Rtilde[i,j]*x[j])^2 / card{T};")
# Resultados y salidas del modelo de optimizacion
media <- ampl$getVariable("media")
varianza<- ampl$getVariable("varianza")
x <- ampl$getVariable("x")
cartera <- x$getValues()
cartera <- cartera[cartera$x.val > 0.001,]
data_return <- data.frame("activ" = cartera$index0, "porc" = cartera$x.val)
data_portfolio <- list(modelo = "maximizacion", cartera = data_return)
save(data_portfolio, file = "../../RData/current_portfolio.RData")
data_return
})
# Modelo basico - minimización del riesgo
Data_min <- reactive({
if(input$indice == "S&P 500"){
load("../../RData/activos.RData")
activos <- activos[5:506,]
updateSelectInput(session,"empresas1", "Seleccione un valor", activos$activo, selected = activos$activo[1])
}
if(input$indice == "NASDAQ 100"){
load("../../RData/activos.RData")
activos <- activos[542:639,]
updateSelectInput(session,"empresas2", "Seleccione un valor", activos$activo, selected = activos$activo[1])
}
if(input$indice == "IBEX 35"){
load("../../RData/activos.RData")
activos <- activos[507:541,]
updateSelectInput(session,"empresas3", "Seleccioneun valor", activos$activo, selected = activos$activo[1])
}
if(input$indice == "EURO STOXX 50"){
load("../../RData/activos.RData")
activos <- activos[640:689,]
updateSelectInput(session,"empresas4", "Seleccione un valor", activos$activo, selected = activos$activo[1])
}
# Datos
valores <- NULL
if(input$indice == "S&P 500"){
empresas <- input$empresas1
}
if(input$indice == "NASDAQ 100"){
empresas <- input$empresas2
}
if(input$indice == "IBEX 35"){
empresas <- input$empresas3
}
if(input$indice == "EURO STOXX 50"){
empresas <- input$empresas4
}
for(i in 1:length(empresas)){
valores <- c(valores, activos$simbolo[activos$activo == empresas[i]][1])
}
datos <- NULL
minDim <- 999999
for(i in 1:length(valores)){
aux <- getSymbols(valores[i], from = input$date_range[1],
to = input$date_range[2], warnings = FALSE, auto.assign = FALSE)
naux <- names(aux)[6]
names(aux) <- c("open", "high", "low", "close", "volume", "adjusted")
if(length(aux$adjusted) < minDim){
minDim <- length(aux$adjusted)
}
}
for(i in 1:length(valores)){
aux <- tail(getSymbols(valores[i], from = input$date_range[1],
to = input$date_range[2], warnings = FALSE, auto.assign = FALSE), n = minDim)
naux <- names(aux)[6]
names(aux) <- c("open", "high", "low", "close", "volume", "adjusted")
datos <- cbind(datos, aux$adjusted)
names(datos)[dim(datos)[2]] <- naux
}
datos <- as.data.frame(datos)
# Eliminar valores na generados como fruto de mezclar valores que pueden haber
# cotizado en diferentes dias al ser de mercados diferentes y que se produzca el
# caso de que un valor un dia no ha cotizado y otros valores si lo han hecho
datos <- drop_na(datos)
# Valores que utilizamos (retornos).
returns <- 1 + Return.calculate(datos)
returns <- returns[-1,]
# Preparacion para AMPL
A <- names(datos)
A <- gsub("=", ".", A)
str_sub(A, -9) <- ""
A <- str_c(A, collapse = " ")
a <- str_c("set A :=\n", A, ";", sep = "")
b <- str_c("param R:\n", A, " :=\n", sep = "")
dat <- str_c(a, b, sep = "\n")
data.ampl <- cbind(seq(1, dim(returns)[1]), returns)
c <- apply(data.ampl, 2, str_c, sep = "")
c <- apply(c, 1, str_c, collapse = " ")
c <- str_c(c, collapse = "\n")
dat <- str_c(dat, c, collapse = "\n")
dat <- str_c(dat, ";", collapse = "\n")
dias <- seq(1, dim(returns)[1])
a <- str_c("set T := {1..", dim(returns)[1],"};", sep = "")
n <- input$cardinalidad_valores
d <- "subject to num_empresas:"
e <- str_c(d, "sum{j in A} y[j] <=", collapse = "\n")
e <- str_c(e, n, collapse = " ")
e <- str_c(e, ";", collapse = "")
e2 <- str_c(d, "sum{j in A} y[j] =", collapse = "\n")
e2 <- str_c(e2, n, collapse = " ")
e2 <- str_c(e2, ";", collapse = "")
f <- str_c("subject to cota_inferior {j in A}: ",input$cota_inferior/100,"*y[j]<=x[j];", collapse = "")
g <- str_c("subject to cota_superior {j in A}: x[j]<=",input$cota_superior/100,"*y[j];data;", collapse = "")
p <- input$discount
h <- str_c("param mean {j in A}:= ( sum{i in T}",p,"^(card(T) - i) * R[i,j])/( sum {i in T}",p,"^(card(T) - i));",collapse = "")
#########
# AMPL
#########
ampl$eval("# Objective: convex quadratic
# Constraints: linear
reset;
set A;")
ampl$eval(a)
b <- str_c("param r_min default ", input$min_rentabilidad, ";", sep = "")
ampl$eval(b)
ampl$eval("param R {T,A};")
if(input$rentabilidad == "Media"){
ampl$eval("param mean {j in A}
:= ( sum{i in T} R[i,j] )/card(T);")
}else{
ampl$eval(h)
}
ampl$eval("param Rtilde {i in T, j in A}
:= R[i,j] - mean[j];
param Cov {j in A, k in A}
:= sum {i in T} (Rtilde[i,j]*Rtilde[i,k]) / card(T);
param Corr {j in A, k in A}
:= Cov[j,k]/sqrt(Cov[j,j]*Cov[k,k]);
var x{A} >=0;
var y{A} binary;
minimize risk:
sum{i in T} (sum{j in A} Rtilde[i,j]*x[j])^2 / card{T} ;
subject to reward_bound:
r_min <= sum{j in A} mean[j]*x[j];
subject to tot_mass:
sum{j in A} x[j] = 1;")
# Maximo invertir en n empresas
if(input$cota_inferior != 0){
ampl$eval(e2)
}
else{
ampl$eval(e)
}
# Minimo un % en cada una
ampl$eval(f)
# Maximo un % en cada una
ampl$eval(g)
ampl$eval(dat)
ampl$eval("# solver cplex
option solver cplex;
# sharpe:= (sum{i in A} x[i]*mean[i])
")
ampl$solve()
ampl$eval("var media = sum{j in A} mean[j]*x[j];")
ampl$eval("var varianza = sum{i in T} (sum{j in A} Rtilde[i,j]*x[j])^2 / card{T};")
# Salidas y resultados del modelo de optimizacion
medias <- ampl$getVariable("media")
varianza<- ampl$getVariable("varianza")
x <- ampl$getVariable("x")
cartera <- x$getValues()
cartera <- cartera[cartera$x.val > 0.001,]
data_return <- data.frame("activ" = cartera$index0, "porc" = cartera$x.val)
data_portfolio <- list(modelo = "minimizacion", cartera = data_return)
save(data_portfolio, file = "../../RData/current_portfolio.RData")
data_return
})
Data_markowitz <- reactive({
if(input$indice == "S&P 500"){
load("../../RData/activos.RData")
activos <- activos[5:506,]
updateSelectInput(session,"empresas1", "Seleccione un valor", activos$activo, selected = activos$activo[1])
}
if(input$indice == "NASDAQ 100"){
load("../../RData/activos.RData")
activos <- activos[542:639,]
updateSelectInput(session,"empresas2", "Seleccione un valor", activos$activo, selected = activos$activo[1])
}
if(input$indice == "IBEX 35"){
load("../../RData/activos.RData")
activos <- activos[507:541,]
updateSelectInput(session,"empresas3", "Seleccioneun valor", activos$activo, selected = activos$activo[1])
}
if(input$indice == "EURO STOXX 50"){
load("../../RData/activos.RData")
activos <- activos[640:689,]
updateSelectInput(session,"empresas4", "Seleccione un valor", activos$activo, selected = activos$activo[1])
}
if(input$modelos == "Modelo biobjetivo de Markowitz"){
# Datos
valores <- NULL
if(input$indice == "S&P 500"){
empresas <- input$empresas1
}
if(input$indice == "NASDAQ 100"){
empresas <- input$empresas2
}
if(input$indice == "IBEX 35"){
empresas <- input$empresas3
}
if(input$indice == "EURO STOXX 50"){
empresas <- input$empresas4
}
for(i in 1:length(empresas)){
valores <- c(valores, activos$simbolo[activos$activo == empresas[i]][1])
}
datos <- NULL
minDim <- 999999
for(i in 1:length(valores)){
Sys.sleep(1)
aux <- getSymbols(valores[i], from = input$date_range[1],
to = input$date_range[2], warnings = FALSE, auto.assign = FALSE)
naux <- names(aux)[6]
names(aux) <- c("open", "high", "low", "close", "volume", "adjusted")
if(length(aux$adjusted) < minDim){
minDim <- length(aux$adjusted)
}
}
for(i in 1:length(valores)){
Sys.sleep(1)
aux <- tail(getSymbols(valores[i], from = input$date_range[1],
to = input$date_range[2], warnings = FALSE, auto.assign = FALSE), n = minDim)
naux <- names(aux)[6]
names(aux) <- c("open", "high", "low", "close", "volume", "adjusted")
datos <- cbind(datos, aux$adjusted)
names(datos)[dim(datos)[2]] <- naux
}
datos <- as.data.frame(datos)
# Eliminar valores na generados como fruto de mezclar valores que pueden haber
# cotizado en diferentes dias al ser de mercados diferentes y que se produzca el
# caso de que un valor un dia no ha cotizado y otros valores si lo han hecho
datos <- drop_na(datos)
# Valores que utilizamos (retornos).
returns <- 1 + Return.calculate(datos)
returns <- returns[-1,]
# Preparacion para AMPL
A <- names(datos)
A <- gsub("=", ".", A)
str_sub(A, -9) <- ""
A <- str_c(A, collapse = " ")
a <- str_c("set A :=\n", A, ";", sep = "")
b <- str_c("param R:\n", A, " :=\n", sep = "")
dat <- str_c(a, b, sep = "\n")
data.ampl <- cbind(seq(1, dim(returns)[1]), returns)
c <- apply(data.ampl, 2, str_c, sep = "")
c <- apply(c, 1, str_c, collapse = " ")
c <- str_c(c, collapse = "\n")
dat <- str_c(dat, c, collapse = "\n")
dat <- str_c(dat, ";", collapse = "\n")
dias <- seq(1, dim(returns)[1])
a <- str_c("set T := {1..", dim(returns)[1],"};", sep = "")
# Distintos valores de mu para obtener la frontera eficiente
mu_values <- c(0, 0.1, 0.5, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15,
16, 17, 18, 19, 20, 25, 30, 35, 40, 45, 50, 55, 60, 65, 70, 75,
100, 125, 150, 175, 200, 300, 500, 1000)
medias <- NULL
varianzas <- NULL
sharpes <- NULL
carteras <- matrix(0, ncol = length(mu_values), nrow = length(empresas) + 3)
rownames(carteras) <- c(empresas, "media", "varianza", "sharpe")
low <- "param low{i in A} := "
low <- str_c(low, input$cota_inferior, ";", collapse = "")
up <- "param up{i in A} := "
up <- str_c(up, input$cota_superior, ";", collapse = "")
cardinal <- str_c("param cardinal := ", input$cardinalidad_valores, ";", collapse = "")
n <- input$cardinalidad_valores
d <- "subject to num_empresas:"
e <- str_c(d, "sum{j in A} y[j] <=", collapse = "\n")
e <- str_c(e, n, collapse = " ")
e <- str_c(e, ";", collapse = "")
e2 <- str_c(d, "sum{j in A} y[j] =", collapse = "\n")
e2 <- str_c(e2, n, collapse = " ")
e2 <- str_c(e2, ";", collapse = "")
f <- str_c("subject to cota_inferior {j in A}: ",input$cota_inferior/100,"*y[j]<=x[j];", collapse = "")
g <- str_c("subject to cota_superior {j in A}: x[j]<=",input$cota_superior/100,"*y[j];data;", collapse = "")
p <- input$discount
h <- str_c("param mean {j in A}:= ( sum{i in T}",p,"^(card(T) - i) * R[i,j])/( sum {i in T}",p,"^(card(T) - i));",collapse = "")
return <- input$sharpe
m <- str_c("param return:= ",return,";",collapse = "")
#########
# AMPL
#########
for(mui in 1:length(mu_values)){
ampl$eval("# Objective: convex quadratic
# Constraints: linear
reset;
set A;")
ampl$eval(a)
b <- str_c("param mu default ", mu_values[mui], ";", sep = "")
ampl$eval(b)
ampl$eval("param R {T,A};")
if(input$rentabilidad == "Media"){
ampl$eval("param mean {j in A}
:= ( sum{i in T} R[i,j] )/card(T);")
}else{
ampl$eval(h)
}
ampl$eval("param Rtilde {i in T, j in A}
:= R[i,j] - mean[j];
param Cov {j in A, k in A}
:= sum {i in T} (Rtilde[i,j]*Rtilde[i,k]) / card(T);
param Corr {j in A, k in A}
:= Cov[j,k]/sqrt(Cov[j,j]*Cov[k,k]);")
ampl$eval(m)
ampl$eval("var x{A} >=0;
var y{A} binary;
minimize lin_comb:
mu *
sum{i in T} (sum{j in A} Rtilde[i,j]*x[j])^2 / card{T}
-
sum{j in A} mean[j]*x[j]
;
subject to tot_mass:
sum{j in A} x[j] = 1;")
# Maximo invertir en n empresas
if(input$cota_inferior != 0){
ampl$eval(e2)
}
else{
ampl$eval(e)
}
# Minimo un % en cada una
ampl$eval(f)
# Maximo un % en cada una
ampl$eval(g)
ampl$eval(dat)
ampl$eval("# solver cplex
option solver cplex;
# sharpe:= (sum{i in A} x[i]*mean[i])
")
ampl$solve()
ampl$eval("var media = sum{j in A} mean[j]*x[j];")
ampl$eval("var varianza = sum{i in T} (sum{j in A} Rtilde[i,j]*x[j])^2 / card{T};")
ampl$eval("var sharpe = (sum {i in A} x[i] * mean[i] - return)/(sum {i in T} (sum {j in A} Rtilde[i,j] * x[j])^2 / card(T))^(0.5);")
# Salidas y resultados del modelo de optimizacion
medias_aux <- ampl$getVariable("media")
medias <- c(medias, medias_aux$value())
var_aux <- ampl$getVariable("varianza")
varianzas <- c(varianzas, var_aux$value())
sharpes_aux <- ampl$getVariable("sharpe")
sharpes <- c(sharpes, sharpes_aux$value())
x <- ampl$getVariable("x")
cartera <- x$getValues()
cartera <- cartera$x.val
cartera <- c(cartera, medias_aux$value())
cartera <- c(cartera, var_aux$value())
cartera <- c(cartera, sharpes_aux$value())
carteras[,mui] <- cartera
}
medias <- (medias - 1)*100
varianzas <- varianzas * 100
data_return <- list(dataframe = data.frame(medias, varianzas, sharpes), valores_cartera = carteras)
data_portfolio <- list(modelo = "markowitz", cartera = data_return)
save(data_portfolio, file = "../../RData/current_portfolio.RData")
data_return
}
})
# Modelo de Markowitz
Data_markowitz2 <- reactive({
if(input$indice == "S&P 500"){
load("../../RData/activos.RData")
activos <- activos[5:506,]
updateSelectInput(session,"empresas1", "Seleccione un valor", activos$activo, selected = activos$activo[1])
}
if(input$indice == "NASDAQ 100"){
load("../../RData/activos.RData")
activos <- activos[542:639,]
updateSelectInput(session,"empresas2", "Seleccione un valor", activos$activo, selected = activos$activo[1])
}
if(input$indice == "IBEX 35"){
load("../../RData/activos.RData")
activos <- activos[507:541,]
updateSelectInput(session,"empresas3", "Seleccioneun valor", activos$activo, selected = activos$activo[1])
}
if(input$indice == "EURO STOXX 50"){
load("../../RData/activos.RData")
activos <- activos[640:689,]
updateSelectInput(session,"empresas4", "Seleccione un valor", activos$activo, selected = activos$activo[1])
}
if(input$modelos == "Modelo biobjetivo de Markowitz"){
# Datos
valores <- NULL
if(input$indice == "S&P 500"){
empresas <- input$empresas1
}
if(input$indice == "NASDAQ 100"){
empresas <- input$empresas2
}
if(input$indice == "IBEX 35"){
empresas <- input$empresas3
}
if(input$indice == "EURO STOXX 50"){
empresas <- input$empresas4
}
for(i in 1:length(empresas)){
valores <- c(valores, activos$simbolo[activos$activo == empresas[i]][1])
}
datos <- NULL
minDim <- 999999
for(i in 1:length(valores)){
Sys.sleep(1)
aux <- getSymbols(valores[i], from = input$date_range[1],
to = input$date_range[2], warnings = FALSE, auto.assign = FALSE)
naux <- names(aux)[6]
names(aux) <- c("open", "high", "low", "close", "volume", "adjusted")
if(length(aux$adjusted) < minDim){
minDim <- length(aux$adjusted)
}
}
for(i in 1:length(valores)){
Sys.sleep(1)
aux <- tail(getSymbols(valores[i], from = input$date_range[1],
to = input$date_range[2], warnings = FALSE, auto.assign = FALSE), n = minDim)
naux <- names(aux)[6]
names(aux) <- c("open", "high", "low", "close", "volume", "adjusted")
datos <- cbind(datos, aux$adjusted)
names(datos)[dim(datos)[2]] <- naux
}
datos <- as.data.frame(datos)
# Eliminar valores na generados como fruto de mezclar valores que pueden haber
# cotizado en diferentes dias al ser de mercados diferentes y que se produzca el
# caso de que un valor un dia no ha cotizado y otros valores si lo han hecho
datos <- drop_na(datos)
# Valores que utilizamos (retornos).
returns <- 1 + Return.calculate(datos)
returns <- returns[-1,]
# print(returns)
# Preparacion para AMPL
A <- names(datos)
A <- gsub("=", ".", A)
str_sub(A, -9) <- ""
A <- str_c(A, collapse = " ")
a <- str_c("set A :=\n", A, ";", sep = "")
b <- str_c("param R:\n", A, " :=\n", sep = "")
dat <- str_c(a, b, sep = "\n")
data.ampl <- cbind(seq(1, dim(returns)[1]), returns)
c <- apply(data.ampl, 2, str_c, sep = "")
c <- apply(c, 1, str_c, collapse = " ")
c <- str_c(c, collapse = "\n")
dat <- str_c(dat, c, collapse = "\n")
dat <- str_c(dat, ";", collapse = "\n")
dias <- seq(1, dim(returns)[1])
a <- str_c("set T := {1..", dim(returns)[1],"};", sep = "")
mu <- input$mu
low <- "param low{i in A} := "
low <- str_c(low, input$cota_inferior, ";", collapse = "")
up <- "param up{i in A} := "
up <- str_c(up, input$cota_superior, ";", collapse = "")
cardinal <- str_c("param cardinal := ", input$cardinalidad_valores, ";", collapse = "")
n <- input$cardinalidad_valores
d <- "subject to num_empresas:"
e <- str_c(d, "sum{j in A} y[j] <=", collapse = "\n")
e <- str_c(e, n, collapse = " ")
e <- str_c(e, ";", collapse = "")
e2 <- str_c(d, "sum{j in A} y[j] =", collapse = "\n")
e2 <- str_c(e2, n, collapse = " ")
e2 <- str_c(e2, ";", collapse = "")
f <- str_c("subject to cota_inferior {j in A}: ",input$cota_inferior/100,"*y[j]<=x[j];", collapse = "")
g <- str_c("subject to cota_superior {j in A}: x[j]<=",input$cota_superior/100,"*y[j];data;", collapse = "")
p <- input$discount
h <- str_c("param mean {j in A}:= ( sum{i in T}",p,"^(card(T) - i) * R[i,j])/( sum {i in T}",p,"^(card(T) - i));",collapse = "")
return <- input$sharpe
m <- str_c("param return:= ",return,";",collapse = "")
#########
# AMPL
#########
ampl$eval("# Objective: convex quadratic
# Constraints: linear
reset;
set A;")
ampl$eval(a)
b <- str_c("param mu default ", mu, ";", sep = "")
ampl$eval(b)
ampl$eval("param R {T,A};")
if(input$rentabilidad == "Media"){
ampl$eval("param mean {j in A}
:= ( sum{i in T} R[i,j] )/card(T);")
}else{
ampl$eval(h)
}
ampl$eval("param Rtilde {i in T, j in A}
:= R[i,j] - mean[j];
param Cov {j in A, k in A}
:= sum {i in T} (Rtilde[i,j]*Rtilde[i,k]) / card(T);
param Corr {j in A, k in A}
:= Cov[j,k]/sqrt(Cov[j,j]*Cov[k,k]);")
ampl$eval(m)
ampl$eval("var x{A} >=0;
var y{A} binary;
minimize lin_comb:
mu *
sum{i in T} (sum{j in A} Rtilde[i,j]*x[j])^2 / card{T}
-
sum{j in A} mean[j]*x[j]
;
subject to tot_mass:
sum{j in A} x[j] = 1;")
# Maximo invertir en n empresas
if(input$cota_inferior != 0){
ampl$eval(e2)
}
else{
ampl$eval(e)
}
# Minimo un % en cada una
ampl$eval(f)
# print(f)
# Maximo un % en cada una
ampl$eval(g)
ampl$eval(dat)
ampl$eval("# solver cplex
option solver cplex;
# sharpe:= (sum{i in A} x[i]*mean[i])
")
ampl$solve()
ampl$eval("var media = sum{j in A} mean[j]*x[j];")
ampl$eval("var varianza = sum{i in T} (sum{j in A} Rtilde[i,j]*x[j])^2 / card{T};")
ampl$eval("var sharpe = (sum {i in A} x[i] * mean[i] - return)/(sum {i in T} (sum {j in A} Rtilde[i,j] * x[j])^2 / card(T))^(0.5);")
# Salidas y resultados del modelo de optimizacion
media <- c(ampl$getVariable("media"))
varianza <- c(ampl$getVariable("varianza"))
sharpe <- c(ampl$getVariable("sharpe"))
x <- ampl$getVariable("x")
cartera <- x$getValues()
cartera <- cartera[cartera$x.val > 0.001,]
data_return <- data.frame("activ" = cartera$index0, "porc" = cartera$x.val)
data_portfolio <- list(modelo = "markowitz2", cartera = data_return, mu = input$mu)
save(data_portfolio, file = "../../RData/current_portfolio.RData")
data_return
}
})
Data_empresas <- reactive({
if(input$indice == "S&P 500"){
load("../../RData/activos.RData")
activos <- activos[5:506,]
updateSelectInput(session,"empresas1", "Seleccione un valor", activos$activo, selected = activos$activo[1])
}
if(input$indice == "NASDAQ 100"){
load("../../RData/activos.RData")
activos <- activos[542:639,]
updateSelectInput(session,"empresas2", "Seleccione un valor", activos$activo, selected = activos$activo[1])
}
if(input$indice == "IBEX 35"){
load("../../RData/activos.RData")
activos <- activos[507:541,]
updateSelectInput(session,"empresas3", "Seleccioneun valor", activos$activo, selected = activos$activo[1])
}
if(input$indice == "EURO STOXX 50"){
load("../../RData/activos.RData")
activos <- activos[640:689,]
updateSelectInput(session,"empresas4", "Seleccione un valor", activos$activo, selected = activos$activo[1])
}
# Datos
valores <- NULL
if(input$indice == "S&P 500"){
empresas <- input$empresas1
}
if(input$indice == "NASDAQ 100"){
empresas <- input$empresas2
}
if(input$indice == "IBEX 35"){
empresas <- input$empresas3
}
if(input$indice == "EURO STOXX 50"){
empresas <- input$empresas4
}
for(i in 1:length(empresas)){
valores <- c(valores, activos$simbolo[activos$activo == empresas[i]][1])
}
datos <- NULL
minDim <- 999999
for(i in 1:length(valores)){
Sys.sleep(1)
aux <- getSymbols(valores[i], from = input$date_range[1],
to = input$date_range[2], warnings = FALSE, auto.assign = FALSE)
naux <- names(aux)[6]
names(aux) <- c("open", "high", "low", "close", "volume", "adjusted")
if(length(aux$adjusted) < minDim){
minDim <- length(aux$adjusted)
}
}
for(i in 1:length(valores)){
Sys.sleep(1)
aux <- tail(getSymbols(valores[i], from = input$date_range[1],
to = input$date_range[2], warnings = FALSE, auto.assign = FALSE), n = minDim)
naux <- names(aux)[6]
names(aux) <- c("open", "high", "low", "close", "volume", "adjusted")
datos <- cbind(datos, aux$adjusted)
names(datos)[dim(datos)[2]] <- naux
}
datos <- as.data.frame(datos)
# Eliminar valores na generados como fruto de mezclar valores que pueden haber
# cotizado en diferentes dias al ser de mercados diferentes y que se produzca el
# caso de que un valor un dia no ha cotizado y otros valores si lo han hecho
datos <- drop_na(datos)
returns <- Return.calculate(datos)
returns <- returns[-1,]
emp <- unlist(strsplit(names(returns), "\\.Ad"))
emp <- emp[emp != "justed"]
data_return <- data.frame(returns)
names(data_return) <- emp
data_return
})
data_sp500 <- reactive({
load("../../RData/activos.RData")
activos <- activos[5:506,]
sp500 <- getSymbols("^GSPC", from = input$date_range[1],
to = input$date_range[2], warnings = FALSE, auto.assign = FALSE)
names(sp500) <- c("open", "high", "low", "close", "volume", "adjusted")
empresas <- paste(input$empresas1)
# Datos
valores <- NULL
for(i in 1:length(empresas)){
valores <- c(valores, activos$simbolo[activos$activo == empresas[i]][1])
}
datos <- NULL
minDim <- 999999
for(i in 1:length(valores)){
Sys.sleep(1)
aux <- getSymbols(valores[i], from = input$date_range[1],
to = input$date_range[2], warnings = FALSE, auto.assign = FALSE)
naux <- names(aux)[6]
names(aux) <- c("open", "high", "low", "close", "volume", "adjusted")
if(length(aux$adjusted) < minDim){
minDim <- length(aux$adjusted)
}
}
for(i in 1:length(valores)){
Sys.sleep(1)
aux <- tail(getSymbols(valores[i], from = input$date_range[1],
to = input$date_range[2], warnings = FALSE, auto.assign = FALSE), n = minDim)
naux <- names(aux)[6]
names(aux) <- c("open", "high", "low", "close", "volume", "adjusted")
datos <- cbind(datos, aux$adjusted)
names(datos)[dim(datos)[2]] <- naux
}
sp500aux <- tail(getSymbols("^GSPC", from = input$date_range[1],
to = input$date_range[2], warnings = FALSE, auto.assign = FALSE), n = minDim)
naux <- names(sp500aux)[6]
names(sp500aux) <- c("open", "high", "low", "close", "volume", "adjusted")
datos_sp500 <- sp500aux$adjusted
names(datos_sp500)[dim(datos_sp500)[2]] <- naux
datos_sp500 <- as.data.frame(datos_sp500)
# Eliminar valores na generados como fruto de mezclar valores que pueden haber
# cotizado en diferentes dias al ser de mercados diferentes y que se produzca el
# caso de que un valor un dia no ha cotizado y otros valores si lo han hecho
datos_sp500 <- drop_na(datos_sp500)
returns_sp500 <- Return.calculate(datos_sp500)
returns_sp500 <- returns_sp500[-1,]
returns_sp500
})
data_nasdaq100 <- reactive({
load("../../RData/activos.RData")
activos <- activos[542:639,]
nasdaq100 <- getSymbols("^NDX", from = input$date_range[1],
to = input$date_range[2], warnings = FALSE, auto.assign = FALSE)
names(nasdaq100) <- c("open", "high", "low", "close", "volume", "adjusted")
empresas <- paste(input$empresas2)
# Datos
valores <- NULL
for(i in 1:length(empresas)){
valores <- c(valores, activos$simbolo[activos$activo == empresas[i]][1])
}
datos <- NULL
minDim <- 999999
for(i in 1:length(valores)){
Sys.sleep(1)
aux <- getSymbols(valores[i], from = input$date_range[1],
to = input$date_range[2], warnings = FALSE, auto.assign = FALSE)
naux <- names(aux)[6]
names(aux) <- c("open", "high", "low", "close", "volume", "adjusted")
if(length(aux$adjusted) < minDim){
minDim <- length(aux$adjusted)
}
}
for(i in 1:length(valores)){
Sys.sleep(1)
aux <- tail(getSymbols(valores[i], from = input$date_range[1],
to = input$date_range[2], warnings = FALSE, auto.assign = FALSE), n = minDim)
naux <- names(aux)[6]
names(aux) <- c("open", "high", "low", "close", "volume", "adjusted")
datos <- cbind(datos, aux$adjusted)
names(datos)[dim(datos)[2]] <- naux
}
nasdaq100aux <- tail(getSymbols("^NDX", from = input$date_range[1],
to = input$date_range[2], warnings = FALSE, auto.assign = FALSE), n = minDim)
naux <- names(nasdaq100aux)[6]
names(nasdaq100aux) <- c("open", "high", "low", "close", "volume", "adjusted")
datos_nasdaq100 <- nasdaq100aux$adjusted
names(datos_nasdaq100)[dim(datos_nasdaq100)[2]] <- naux
datos_nasdaq100 <- as.data.frame(datos_nasdaq100)
# Eliminar valores na generados como fruto de mezclar valores que pueden haber
# cotizado en diferentes dias al ser de mercados diferentes y que se produzca el
# caso de que un valor un dia no ha cotizado y otros valores si lo han hecho
datos_nasdaq100 <- drop_na(datos_nasdaq100)
returns_nasdaq100 <- Return.calculate(datos_nasdaq100)
returns_nasdaq100 <- returns_nasdaq100[-1,]
returns_nasdaq100
})
data_ibex35 <- reactive({
load("../../RData/activos.RData")
activos <- activos[507:541,]
ibex35 <- getSymbols("^IBEX", from = input$date_range[1],
to = input$date_range[2], warnings = FALSE, auto.assign = FALSE)
names(ibex35) <- c("open", "high", "low", "close", "volume", "adjusted")
empresas <- paste(input$empresas3)
# Datos
valores <- NULL
for(i in 1:length(empresas)){
valores <- c(valores, activos$simbolo[activos$activo == empresas[i]][1])
}
datos <- NULL
minDim <- 999999
for(i in 1:length(valores)){
Sys.sleep(1)
aux <- getSymbols(valores[i], from = input$date_range[1],
to = input$date_range[2], warnings = FALSE, auto.assign = FALSE)
naux <- names(aux)[6]
names(aux) <- c("open", "high", "low", "close", "volume", "adjusted")
if(length(aux$adjusted) < minDim){
minDim <- length(aux$adjusted)
}
}
for(i in 1:length(valores)){
Sys.sleep(1)
aux <- tail(getSymbols(valores[i], from = input$date_range[1],
to = input$date_range[2], warnings = FALSE, auto.assign = FALSE), n = minDim)
naux <- names(aux)[6]
names(aux) <- c("open", "high", "low", "close", "volume", "adjusted")
datos <- cbind(datos, aux$adjusted)
names(datos)[dim(datos)[2]] <- naux
}
ibex35aux <- tail(getSymbols("^IBEX", from = input$date_range[1],
to = input$date_range[2], warnings = FALSE, auto.assign = FALSE), n = minDim)
naux <- names(ibex35aux)[6]
names(ibex35aux) <- c("open", "high", "low", "close", "volume", "adjusted")
datos_ibex35 <- ibex35aux$adjusted
names(datos_ibex35)[dim(datos_ibex35)[2]] <- naux
datos_ibex35 <- as.data.frame(datos_ibex35)
# Eliminar valores na generados como fruto de mezclar valores que pueden haber
# cotizado en diferentes dias al ser de mercados diferentes y que se produzca el
# caso de que un valor un dia no ha cotizado y otros valores si lo han hecho
datos_ibex35 <- drop_na(datos_ibex35)
returns_ibex35 <- Return.calculate(datos_ibex35)
returns_ibex35 <- returns_ibex35[-1,]
returns_ibex35
})
data_eurostoxx50 <- reactive({
load("../../RData/activos.RData")
activos <- activos[640:689,]
eurostoxx50 <- getSymbols("^STOXX50E", from = input$date_range[1],
to = input$date_range[2], warnings = FALSE, auto.assign = FALSE)
names(eurostoxx50) <- c("open", "high", "low", "close", "volume", "adjusted")
empresas <- paste(input$empresas4)
# Datos
valores <- NULL
for(i in 1:length(empresas)){
valores <- c(valores, activos$simbolo[activos$activo == empresas[i]][1])
}
datos <- NULL
minDim <- 999999
for(i in 1:length(valores)){
Sys.sleep(1)
aux <- getSymbols(valores[i], from = input$date_range[1],
to = input$date_range[2], warnings = FALSE, auto.assign = FALSE)
naux <- names(aux)[6]
names(aux) <- c("open", "high", "low", "close", "volume", "adjusted")
if(length(aux$adjusted) < minDim){
minDim <- length(aux$adjusted)
}
}
for(i in 1:length(valores)){
Sys.sleep(1)
aux <- tail(getSymbols(valores[i], from = input$date_range[1],
to = input$date_range[2], warnings = FALSE, auto.assign = FALSE), n = minDim)
naux <- names(aux)[6]
names(aux) <- c("open", "high", "low", "close", "volume", "adjusted")
datos <- cbind(datos, aux$adjusted)
names(datos)[dim(datos)[2]] <- naux
}
eurostoxx50aux <- tail(getSymbols("^STOXX50E", from = input$date_range[1],
to = input$date_range[2], warnings = FALSE, auto.assign = FALSE), n = minDim)
naux <- names(eurostoxx50aux)[6]
names(eurostoxx50aux) <- c("open", "high", "low", "close", "volume", "adjusted")
datos_eurostoxx50 <- eurostoxx50aux$adjusted
names(datos_eurostoxx50)[dim(datos_eurostoxx50)[2]] <- naux
datos_eurostoxx50 <- as.data.frame(datos_eurostoxx50)
# Eliminar valores na generados como fruto de mezclar valores que pueden haber
# cotizado en diferentes dias al ser de mercados diferentes y que se produzca el
# caso de que un valor un dia no ha cotizado y otros valores si lo han hecho
datos_eurostoxx50 <- drop_na(datos_eurostoxx50)
returns_eurostoxx50 <- Return.calculate(datos_eurostoxx50)
returns_eurostoxx50 <- returns_eurostoxx50[-1,]
returns_eurostoxx50
})
pdf(NULL)
output$grafico <- renderPlotly({
if((input$indice == "S&P 500" && length(input$empresas1) > 1) ||
(input$indice == "NASDAQ 100" && length(input$empresas2) > 1) ||
(input$indice == "IBEX 35" && length(input$empresas3) > 1) ||
(input$indice == "EURO STOXX 50" && length(input$empresas4) > 1)){
if(input$modelos == "Modelo biobjetivo de Markowitz"){
datos <- Data_empresas()
if(input$tipo_cartera == "Óptima en función de mu"){
data <- Data_markowitz2()
datos_x <- NULL
valores <- data$activ
porc <- data$porc
for(i in valores){
for(j in names(datos)){
if(i == j){
datos_x <- cbind(datos_x, datos[,j])
}
}
}
colnames(datos_x) <- valores
#datos_x <- data.frame(datos_x)
rownames(datos_x) <- rownames(data.frame(datos))
data <- NULL
if(!is.null(dim(datos_x))){
for(i in 1:dim(datos_x)[1]){
data <- c(data, sum(datos_x[i,]*porc))
}
}else{
data <- datos_x
}
ejey <- "Cartera óptima"
}else{
carteras <- Data_markowitz()$valores_cartera
valores <- head(rownames(carteras), -3)
datos_mark <- Data_markowitz()$dataframe
index_min_riesgo <- which.min(datos_mark$medias)
index_max_rentabilidad <- which.max(datos_mark$medias)
index_max_sharpe <- which.max(datos_mark$sharpes)
cartera_min_riesgo <- head(carteras[,index_min_riesgo], -3)
cartera_max_rentabilidad <- head(carteras[,index_max_rentabilidad], -3)
cartera_max_sharpe <- head(carteras[,index_max_sharpe], -3)
cartera_equi <- 1/dim(carteras)[2]
cartera_equi <- rep(cartera_equi, dim(carteras)[2])
rend_min_riesgo <- NULL
rend_max_rentabilidad <- NULL
rend_max_sharpe <- NULL
rend_equi <- NULL
for(i in 1:dim(datos)[1]){
rend_min_riesgo <- c(rend_min_riesgo, sum(datos[i,]*cartera_min_riesgo))
rend_max_rentabilidad <- c(rend_max_rentabilidad, sum(datos[i,]*cartera_max_rentabilidad))
rend_max_sharpe <- c(rend_max_sharpe, sum(datos[i,]*cartera_max_sharpe))
rend_equi <- c(rend_equi, sum(datos[i,]*cartera_equi))
}
rend_min_riesgo <- cumsum(rend_min_riesgo)
rend_max_rentabilidad <- cumsum(rend_max_rentabilidad)
rend_max_sharpe <- cumsum(rend_max_sharpe)
rend_equi <- cumsum(rend_equi)
}
if(input$tipo_cartera == "Máximo rendimiento"){
X <- rend_max_rentabilidad
ejey <- "Máximo rendimiento"
}
if(input$tipo_cartera == "Mínimo riesgo"){
X <- rend_min_riesgo
ejey <- "Mínimo riesgo"
}
if(input$tipo_cartera == "Máximo ratio Sharpe"){
X <- rend_max_sharpe
ejey <- "Máximo ratio Sharpe"
}
if(input$tipo_cartera == "Equiponderada"){
X <- rend_equi
ejey <- "Equiponderada"
}
if(input$tipo_cartera == "Óptima en función de mu"){
X <- data
}
if(input$indice == "S&P 500"){
y <- data_sp500()
}
if(input$indice == "NASDAQ 100"){
y <- data_nasdaq100()
}
if(input$indice == "IBEX 35"){
y <- data_ibex35()
}
if(input$indice == "EURO STOXX 50"){
y <- data_eurostoxx50()
}
data <- cbind(y, X)
data <- data.frame(data)
lm_model <- linear_reg() %>%
set_engine('lm') %>%
set_mode('regression') %>%
fit(y ~ X, data = data)
R2 <- round(glance(lm_model)$r.squared, 4)
x_range <- seq(min(X), max(X), length.out = dim(data)[1])
x_range <- matrix(x_range, nrow = dim(data)[1], ncol = 1)
xdf <- data.frame(x_range)
colnames(xdf) <- c('X')
ydf <- lm_model %>% predict(xdf)
colnames(ydf) <- c('y')
xy <- data.frame(xdf, ydf)
if(input$tipo_cartera == "Máximo rendimiento"){
fig <- plot_ly(data, x = ~X, y = ~y, type = 'scatter', alpha = 0.65, mode = 'markers', name = 'Cartera de máximo rendimiento')
}
if(input$tipo_cartera == "Mínimo riesgo"){
fig <- plot_ly(data, x = ~X, y = ~y, type = 'scatter', alpha = 0.65, mode = 'markers', name = 'Cartera de mínimo riesgo')
}
if(input$tipo_cartera == "Máximo ratio Sharpe"){
fig <- plot_ly(data, x = ~X, y = ~y, type = 'scatter', alpha = 0.65, mode = 'markers', name = 'Cartera de máximo ratio Sharpe')
}
if(input$tipo_cartera == "Equiponderada"){
fig <- plot_ly(data, x = ~X, y = ~y, type = 'scatter', alpha = 0.65, mode = 'markers', name = 'Cartera equiponderada')
}
if(input$tipo_cartera == "Óptima en función de mu"){
fig <- plot_ly(data, x = ~y, y = ~X, type = 'scatter', alpha = 0.65, mode = 'markers', name = paste("Cartera óptima con mu =",input$mu))
}
fig <- fig %>% add_trace(data = xy, x = ~X, y = ~y, name = 'Regresión', mode = 'lines', alpha = 1)
fig <- fig %>% add_annotations(text = paste("R2 =",R2), x = min(xy$X), y = min(data$y) - 0.03, showarrow = FALSE)
if(input$indice == "S&P 500"){
fig <- fig %>% layout(xaxis = list(title = 'S&P 500',
range = list(c(min(data$X) - 0.05), max(data$X) + 0.05)),
yaxis = list(title = ejey,
range = list(c(min(data$y) - 0.05), max(data$y) + 0.05)))
}
if(input$indice == "NASDAQ 100"){
fig <- fig %>% layout(xaxis = list(title = 'NASDAQ 100',
range = list(c(min(data$X) - 0.05), max(data$X) + 0.05)),
yaxis = list(title = ejey,
range = list(c(min(data$y) - 0.05), max(data$y) + 0.05)))
}
if(input$indice == "IBEX 35"){
fig <- fig %>% layout(xaxis = list(title = 'IBEX 35',
range = list(c(min(data$X) - 0.05), max(data$X) + 0.05)),
yaxis = list(title = ejey,
range = list(c(min(data$y) - 0.05), max(data$y) + 0.05)))
}
if(input$indice == "EURO STOXX 50"){
fig <- fig %>% layout(xaxis = list(title = 'EURO STOXX 50',
range = list(c(min(data$X) - 0.05), max(data$X) + 0.05)),
yaxis = list(title = ejey,
range = list(c(min(data$y) - 0.05), max(data$y) + 0.05)))
}
}
else{
datos <- Data_empresas()
if(input$modelos == "Modelo de maximización de la renta"){
data <- Data_max()
datos_x <- NULL
valores <- data$activ
porc <- data$porc
for(i in valores){
for(j in names(datos)){
if(i == j){
datos_x <- cbind(datos_x, datos[,j])
}
}
}
colnames(datos_x) <- valores
#datos_x <- data.frame(datos_x)
rownames(datos_x) <- rownames(data.frame(datos))
data <- NULL
if(!is.null(dim(datos_x))){
for(i in 1:dim(datos_x)[1]){
data <- c(data, sum(datos_x[i,]*porc))
}
}else{
data <- datos_x
}
X <- data
if(input$indice == "S&P 500"){
y <- data_sp500()
}
if(input$indice == "NASDAQ 100"){
y <- data_nasdaq100()
}
if(input$indice == "IBEX 35"){
y <- data_ibex35()
}
if(input$indice == "EURO STOXX 50"){
y <- data_eurostoxx50()
}
data <- cbind(y, X)
data <- data.frame(data)
lm_model <- linear_reg() %>%
set_engine('lm') %>%
set_mode('regression') %>%
fit(y ~ X, data = data)
R2 <- round(glance(lm_model)$r.squared, 4)
x_range <- seq(min(X), max(X), length.out = dim(data)[1])
x_range <- matrix(x_range, nrow = dim(data)[1], ncol = 1)
xdf <- data.frame(x_range)
colnames(xdf) <- c('X')
ydf <- lm_model %>% predict(xdf)
colnames(ydf) <- c('y')
xy <- data.frame(xdf, ydf)
ejey <- "Cartera óptima"
fig <- plot_ly(data, x = ~X, y = ~y, type = 'scatter', alpha = 0.65, mode = 'markers', name = 'Cartera óptima modelo de maximización de la renta')
fig <- fig %>% add_trace(data = xy, x = ~X, y = ~y, name = 'Regresión', mode = 'lines', alpha = 1)
fig <- fig %>% add_annotations(text = paste("R2 =",R2), x = min(xy$X), y = min(data$y) - 0.03, showarrow = FALSE)
fig <- fig %>% layout(xaxis = list(range = list(c(min(data$X) - 0.05), max(data$X) + 0.05)),
yaxis = list(title = ejey,
range = list(c(min(data$y) - 0.05), max(data$y) + 0.05)))
}
if(input$modelos == "Modelo de minimización del riesgo"){
data <- Data_min()
datos_x <- NULL
valores <- data$activ
porc <- data$porc
for(i in valores){
for(j in names(datos)){
if(i == j){
datos_x <- cbind(datos_x, datos[,j])
}
}
}
colnames(datos_x) <- valores
#datos_x <- data.frame(datos_x)
rownames(datos_x) <- rownames(data.frame(datos))
data <- NULL
if(!is.null(dim(datos_x))){
for(i in 1:dim(datos_x)[1]){
data <- c(data, sum(datos_x[i,]*porc))
}
}else{
data <- datos_x
}
X <- data
if(input$indice == "S&P 500"){
y <- data_sp500()
}
if(input$indice == "NASDAQ 100"){
y <- data_nasdaq100()
}
if(input$indice == "IBEX 35"){
y <- data_ibex35()
}
if(input$indice == "EURO STOXX 50"){
y <- data_eurostoxx50()
}
data <- cbind(y, X)
data <- data.frame(data)
lm_model <- linear_reg() %>%
set_engine('lm') %>%
set_mode('regression') %>%
fit(y ~ X, data = data)
R2 <- round(glance(lm_model)$r.squared, 4)
x_range <- seq(min(X), max(X), length.out = dim(data)[1])
x_range <- matrix(x_range, nrow = dim(data)[1], ncol = 1)
xdf <- data.frame(x_range)
colnames(xdf) <- c('X')
ydf <- lm_model %>% predict(xdf)
colnames(ydf) <- c('y')
xy <- data.frame(xdf, ydf)
ejey <- "Cartera óptima"
fig <- plot_ly(data, x = ~X, y = ~y, type = 'scatter', alpha = 0.65, mode = 'markers', name = 'Cartera óptima modelo de minimización del riesgo')
fig <- fig %>% add_trace(data = xy, x = ~X, y = ~y, name = 'Regresión', mode = 'lines', alpha = 1)
fig <- fig %>% add_annotations(text = paste("R2 =",R2), x = min(xy$X), y = min(data$y) - 0.03, showarrow = FALSE)
fig <- fig %>% layout(xaxis = list(range = list(c(min(data$X) - 0.05), max(data$X) + 0.05)),
yaxis = list(title = ejey,
range = list(c(min(data$y) - 0.05), max(data$y) + 0.05)))
}
}
}
fig
}) %>% bindEvent(input$start)
output$tabla_riesgos <- renderTable({
if((input$indice == "S&P 500" && length(input$empresas1) > 1) ||
(input$indice == "NASDAQ 100" && length(input$empresas2) > 1) ||
(input$indice == "IBEX 35" && length(input$empresas3) > 1) ||
(input$indice == "EURO STOXX 50" && length(input$empresas4) > 1)){
if(input$modelos == "Modelo biobjetivo de Markowitz"){
datos <- Data_empresas()
if(input$tipo_cartera == "Óptima en función de mu"){
data <- Data_markowitz2()
datos_x <- NULL
valores <- data$activ
porc <- data$porc
for(i in valores){
for(j in names(datos)){
if(i == j){
datos_x <- cbind(datos_x, datos[,j])
}
}
}
colnames(datos_x) <- valores
#datos_x <- data.frame(datos_x)
rownames(datos_x) <- rownames(data.frame(datos))
data <- NULL
if(!is.null(dim(datos_x))){
for(i in 1:dim(datos_x)[1]){
data <- c(data, sum(datos_x[i,]*porc))
}
}else{
data <- datos_x
}
}else{
carteras <- Data_markowitz()$valores_cartera
valores <- head(rownames(carteras), -3)
datos_mark <- Data_markowitz()$dataframe
index_min_riesgo <- which.min(datos_mark$medias)
index_max_rentabilidad <- which.max(datos_mark$medias)
index_max_sharpe <- which.max(datos_mark$sharpes)
cartera_min_riesgo <- head(carteras[,index_min_riesgo], -3)
cartera_max_rentabilidad <- head(carteras[,index_max_rentabilidad], -3)
cartera_max_sharpe <- head(carteras[,index_max_sharpe], -3)
cartera_equi <- 1/dim(carteras)[2]
cartera_equi <- rep(cartera_equi, dim(carteras)[2])
rend_min_riesgo <- NULL
rend_max_rentabilidad <- NULL
rend_max_sharpe <- NULL
rend_equi <- NULL
for(i in 1:dim(datos)[1]){
rend_min_riesgo <- c(rend_min_riesgo, sum(datos[i,]*cartera_min_riesgo))
rend_max_rentabilidad <- c(rend_max_rentabilidad, sum(datos[i,]*cartera_max_rentabilidad))
rend_max_sharpe <- c(rend_max_sharpe, sum(datos[i,]*cartera_max_sharpe))
rend_equi <- c(rend_equi, sum(datos[i,]*cartera_equi))
}
rend_min_riesgo <- cumsum(rend_min_riesgo)
rend_max_rentabilidad <- cumsum(rend_max_rentabilidad)
rend_max_sharpe <- cumsum(rend_max_sharpe)
rend_equi <- cumsum(rend_equi)
}
if(input$tipo_cartera == "Máximo rendimiento"){
X <- rend_max_rentabilidad
}
if(input$tipo_cartera == "Mínimo riesgo"){
X <- rend_min_riesgo
}
if(input$tipo_cartera == "Máximo ratio Sharpe"){
X <- rend_max_sharpe
}
if(input$tipo_cartera == "Equiponderada"){
X <- rend_equi
}
if(input$tipo_cartera == "Óptima en función de mu"){
X <- data
}
if(input$indice == "S&P 500"){
y <- data_sp500()
}
if(input$indice == "NASDAQ 100"){
y <- data_nasdaq100()
}
if(input$indice == "IBEX 35"){
y <- data_ibex35()
}
if(input$indice == "EURO STOXX 50"){
y <- data_eurostoxx50()
}
data <- cbind(y, X)
data <- data.frame(data)
lm_model <- linear_reg() %>%
set_engine('lm') %>%
set_mode('regression') %>%
fit(y ~ X, data = data)
beta <- round(tidy(lm_model)$estimate, 4)[2]
}
else{
datos <- Data_empresas()
if(input$modelos == "Modelo de maximización de la renta"){
data <- Data_max()
datos_x <- NULL
valores <- data$activ
porc <- data$porc
for(i in valores){
for(j in names(datos)){
if(i == j){
datos_x <- cbind(datos_x, datos[,j])
}
}
}
colnames(datos_x) <- valores
#datos_x <- data.frame(datos_x)
rownames(datos_x) <- rownames(data.frame(datos))
data <- NULL
if(!is.null(dim(datos_x))){
for(i in 1:dim(datos_x)[1]){
data <- c(data, sum(datos_x[i,]*porc))
}
}else{
data <- datos_x
}
X <- data
if(input$indice == "S&P 500"){
y <- data_sp500()
}
if(input$indice == "NASDAQ 100"){
y <- data_nasdaq100()
}
if(input$indice == "IBEX 35"){
y <- data_ibex35()
}
if(input$indice == "EURO STOXX 50"){
y <- data_eurostoxx50()
}
data <- cbind(y, X)
data <- data.frame(data)
lm_model <- linear_reg() %>%
set_engine('lm') %>%
set_mode('regression') %>%
fit(y ~ X, data = data)
beta <- round(tidy(lm_model)$estimate, 4)[2]
}
}
var <- var(y)
riesgo_sistematico <- beta*beta*var
data.frame("Riesgo sistematico" = as.character(riesgo_sistematico), "Riesgo especifico" = as.character(var - riesgo_sistematico),
"Riesgo total" = as.character(var))
}
}) %>% bindEvent(input$start)
}
\ No newline at end of file
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment