program the server to reactivate my static functions

shiny
1

hi, I wrote a few utility function and a main function that compute portfolio weights for a set of inputs which the user select and a few more characteristics for graphical representation. The functions in R work perfectly fine and give a list of matrix/ vectors and a data frame.

here is the code with a dput() of some of the data :

DONNEE<-data.frame(c(structure(list(Name = structure(c(552787200, 552873600, 553132800, 
                                                       553219200, 553305600, 553392000, 553478400, 553737600, 553824000, 
                                                       553910400, 553996800, 554083200, 554342400, 554428800, 554515200, 
                                                       554601600, 554688000, 554947200, 555033600, 555120000, 555206400, 
                                                       555292800, 555552000, 555638400, 555724800, 555811200, 555897600, 
                                                       556156800, 556243200, 556329600, 556416000, 556502400, 556761600, 
                                                       556848000, 556934400, 557020800, 557107200, 557366400, 557452800, 
                                                       557539200, 557625600, 557712000, 557971200, 558057600, 558144000, 
                                                       558230400, 558316800, 558576000, 558662400, 558748800), class = c("POSIXct", 
                                                                                                                         "POSIXt"), tzone = "UTC"), ACCOR...PRICE.INDEX...E.. = c(118.8, 
118.3, 118.3, 118.3, 118.3, 116.3, 116.3, 116.1, 113.1, 114.6, 
116.3, 120.1, 119.6, 118.6, 119.3, 119.1, 118.8, 117.8, 115.2, 
116.3, 117.6, 117.3, 116.8, 116.4, 116.3, 116.2, 117.1, 117.9, 
115.7, 113.9, 114.8, 116.2, 116.9, 116.6, 119.6, 120.3, 122.3, 
124.6, 125.1, 127.1, 126.8, 124.1, 118.1, 120.6, 118.9, 120.6, 
118.6, 118.6, 117.3, 116.1), AIR.LIQUIDE...PRICE.INDEX...E.. = c(1231.7, 
1228.1, 1228.1, 1228.1, 1228.1, 1200, 1212.3, 1208.8, 1191.3, 
1177.2, 1177.2, 1196.5, 1198.3, 1201.8, 1203.5, 1229.9, 1229.9, 
1229.9, 1203.5, 1203.5, 1198.3, 1207.1, 1194.8, 1189.5, 1191.3, 
1198.3, 1224.6, 1226.4, 1208.8, 1203.5, 1187.7, 1186, 1208.8, 
1179, 1228.1, 1235.2, 1240.4, 1236.9, 1229.9, 1222.9, 1203.5, 
1210.6, 1198.3, 1191.3, 1182.5, 1184.2, 1180.7, 1184.2, 1186, 
1184.2), ALCATEL.LUCENT...PRICE.INDEX...E.. = c(103.1, 103.7, 
103.7, 103.7, 103.7, 102.2, 101.2, 100, 101.5, 100.6, 100.6, 
102.1, 102.2, 102.5, 104.2, 105.2, 106.5, 107.4, 105.9, 105.3, 
106.2, 105.6, 105.9, 105.9, 105.3, 105.3, 105.3, 106.8, 106.2, 
105.5, 104.8, 103.7, 104.7, 105, 106.3, 106.8, 106.5, 106.7, 
105.6, 104.6, 104.6, 104.4, 104.2, 104.2, 103.1, 103.6, 103.4, 
104.2, 104.3, 104.6), AXA...PRICE.INDEX...E.. = c(2097.8, 2105.2, 
2105.2, 2105.2, 2084.3, 2047, 1993.2, 1975.3, 1960.4, 1963.4, 
1955.9, 1978.3, 1972.3, 1955.9, 1951.4, 1936.5, 1941, 1955.9, 
1900.7, 1881.3, 1891.7, 1858.9, 1851.4, 1858.9, 1772.3, 1899.2, 
1903.7, 1896.2, 1854.4, 1809.6, 1826, 1851.4, 1851.4, 1858.9, 
1918.6, 1954.4, 2003.7, 2021.6, 2015.6, 1969.4, 1978.3, 1985.8, 
2012.7, 2015.6, 2020.1, 2072.4, 2067.9, 2082.8, 2066.4, 2067.9
), BOUYGUES...PRICE.INDEX...E.. = c(2251.1, 2290.1, 2290.1, 2290.1, 
2290.1, 2181, 2182.9, 2173.2, 2128.3, 2202.4, 2251.1, 2344.7, 
2290.1, 2358.3, 2418.7, 2372, 2391.5, 2368.1, 2274.5, 2270.6, 
2260.9, 2307.7, 2311.6, 2329.1, 2338.8, 2323.2, 2354.4, 2348.6, 
2338.8, 2327.1, 2356.4, 2336.9, 2340.8, 2348.6, 2412.9, 2407.1, 
2397.3, 2416.8, 2397.3, 2416.8, 2438.2, 2455.8, 2418.7, 2414.9, 
2393.4, 2426.5, 2426.5, 2387.6, 2338.8, 2327.1), CAP.GEMINI...PRICE.INDEX...E.. = c(299.9, 
299.9, 299.9, 299.9, 299.9, 298.9, 296.7, 298.3, 298.2, 296.3, 
293, 287.3, 302.1, 304.9, 327.7, 321.9, 315.4, 310.4, 307.2, 
303.1, 308.5, 307.2, 309.7, 307.4, 307.2, 305.9, 311, 309.9, 
309.1, 307.4, 308.2, 316, 320, 312.3, 320.1, 322.5, 319.8, 318.9, 
320, 318.2, 318.1, 317.4, 316.1, 311, 309.1, 313.6, 309.7, 308.5, 
307.2, 312.3), CARREFOUR...PRICE.INDEX...E.. = c(496.3, 495.6, 
495.6, 495.6, 493.4, 490.5, 462.8, 461.6, 461.9, 468.6, 469.8, 
474.5, 469.2, 471.4, 473.7, 470.2, 478.1, 467.2, 465, 467.9, 
475.9, 470.8, 469.4, 457, 465, 473.6, 479.6, 486.1, 481, 479.6, 
477.4, 484.1, 492.8, 502.1, 510.2, 518.8, 521.1, 523.1, 518.9, 
517.5, 524, 532, 523.1, 517.6, 513.1, 511.5, 506.1, 504.3, 502.9, 
491.9), CAC.40...PRICE.INDEX = c(1482.89, 1490.42, 1490.42, 1490.42, 
1490.42, 1474.22, 1462.11, 1457.38, 1444.71, 1446.65, 1461.3, 
1483.55, 1478.54, 1484.7, 1494.49, 1488.41, 1488.31, 1483.02, 
1460.73, 1460.39, 1473.59, 1467.85, 1458.24, 1450.97, 1450.81, 
1458.7, 1486.49, 1487.29, 1471.36, 1461.47, 1466.13, 1471.44, 
1490.7, 1485.92, 1514.55, 1526.59, 1528.97, 1533.59, 1530.11, 
1524, 1550.52, 1560.7, 1535.26, 1531.28, 1522.04, 1530.55, 1530.91,                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              1537.29, 1528.85, 1520.4)), row.names = c(NA, 50L), class = "data.frame")))
 

T<-nrow(DONNEE)

Pt_mat<-data.matrix(DONNEE[,2:(length(DONNEE)-1)])
Rt_mat<-Pt_mat[2:T,]/Pt_mat[1:T-1,]-1
Ptbench_mat<-data.matrix(DONNEE[,length(DONNEE)])
Rtbench_mat<-Ptbench_mat[2:T,]/Ptbench_mat[1:T-1,]-1
VCV_mat<-cov(Rt_mat)

datesALL<-DONNEE[,1]
dt<-(datesALL[2:T]-datesALL[1:T-1])/365
freq<-260
Rf<-0.03
VCV_mat<-cov(Rt_mat)

#### rendements annualises ####
ER<-(1+colMeans(Rt_mat))^(freq)-1  # rendements annualisé des actifs er E(Ri)
ERm<-(1+mean(Rtbench_mat))^(freq)-1
#### rendements geometriques ####
ERg<-(Pt_mat[T,]/Pt_mat[1,])^(freq/T)-1  # rendements géométrique  annualisé des actifs er E(Ri)
ERmg<-(Ptbench_mat[T]/Ptbench_mat[1])^(freq/T)-1    # celui du marche 



# RETOURNE LES ALPHA, BETA ET ECART TYPE DU RESIDUS
CAPM_estim <- function(Rt,Rf,Rm,freq,ER,ERm,N) {
  # Rf valeur annuel
  
  Xcapm<-Rt-((1+Rf)^(1/freq)-1)  # excess return vs taux sans risque
  Y=Rm-((1+Rf)^(1/freq)-1)   # excess return du marche vs taux sans risque
  
  bi=matrix(0,N,1) # vecteur des beta ivs marche
  sei<-matrix(0,N,1) # vecteur des ecart-type du résidu
  
  for (i in 1:N) {
    model<-lm(Xcapm[,i]~Y)
    b=coef(model)
    e=residuals(model)
    bi[i]<-b[2]
    sei[i]<-sd(e)*sqrt(freq)
  }
  
  # calcul des alphas
  ai<-ER-(Rf+(ERm-Rf)*bi)  # alpha de chaque actifs
  return(cbind(ai,bi,sei))
}

portf_equi <- function(N) {
  wequi<-matrix(1/N,N,1)
  return(wequi)
}

portf_actifsureval <- function(Rf,ER,ERm,bi) {
  ERth<-Rf+(ERm-Rf)*bi
  idx<-ER<ERth  # = 1 si les actifs sont surévalués
  Wb<-matrix(1/sum(idx),N,1)*idx  # vecteur des poids du portefeuille equi ponderé des actifs surevalué
  return(Wb)
}

portf_actifsouseval <- function(Rf,ER,ERm,bi) {
  ERth<-Rf+(ERm-Rf)*bi
  idxS<-ER>=ERth# =1 si les actifs sont sous evalué
  Ws<-matrix(1/sum(idxS),N,1)*idxS  # vecteur des poids du portefeuille equi ponderé des actifs sousevalué
  return(Ws)
}

portf_maxinfo <- function(ai,sei,N) {
  Dsei<-matrix(0,N,N)  # matrice diagonale des risques individuel
  diag(Dsei)<-sei^2
  
  # calcul des poids avec Z
  Z<-solve(Dsei)%*%ai
  Wmaxinfo<-Z/sum(Z)
  return(Wmaxinfo)
}

portf_minivar <- function(Rt,freq,ER,N) {
  Un<-rep(1,N) # vecteur unitaire longueur N 
  VCV<-cov(Rt)*freq # matrice variance covariance annualisé sur la période
  c<-t(Un)%*%solve(VCV)%*%Un
  WV<-solve(VCV)%*%Un%*%(1/c)  # poids des actifs dans le portefeuille minimum variance
  return(WV)
}

portf_tangent <- function(Rt,freq,ER,Rf,N) {
  Un<-rep(1,N) # vecteur unitaire longueur N 
  VCV<-cov(Rt)*freq # matrice variance covariance annualisé sur la période
  Ex<-ER-Rf
  ax<-t(Un)%*%solve(VCV)%*%Ex
  WT<-solve(VCV)%*%Ex%*%(1/ax)
  return(WT)
}

rentabiliteportf <- function(poids,Rt) {
  # donne les rendements du portefeuille 
  Rtp<-Rt%*%poids#-managefee*dt    # POUR METTRE LES FRAIS DE GESTION
  return(Rtp)
}

prixportf100  <- function(rentabilite) {
  # donne le prix base 100 a t0
  Ptp<-100*cumprod(1+c(0,rentabilite))
  return(Ptp)
}

frontiereefficiente <- function(Pt,Rt,freq,const,N,VCV) {
  # la variable const est une matrice des seuils des contraintes par lignes avec sur la première 
  #colonnes les contraintes min et sur la deuxième les contraintes max  
  
  library(lpSolve)
  library(quadprog)
  
  # traitement pour l'optimiseur (contraintes)
  # voir l'aide de la fonction lp pour faire le systeme d'optimisation
  
  # etape 1 trouver l'esperance de rentabilité minimal 
  Ui<-matrix(0,N,N)
  diag(Ui)<-1  # matrice identité NxN
  U<-rbind(rep(1,N),Ui,Ui)  # matrice des contraintes (A sur la feuille)
  #C<-c(1,rep(0,N),rep(0.15,N))  # vecteur des contraintes (C sur la feuille)
  C<-c(1,const[,1],const[,2])  # vecteur des contraintes (C sur la feuille)
  
  direction<-c("=",rep(">=",N),rep("<=",N)) # vecteur des directions pour la fonction lp()
  E<- (Pt[T,]/Pt[1,])^(freq/T)-1 # vecteur des rendements annualisé des actifs 
  f_obj=t(E)
  f_con=U
  f_dir=direction
  f_rhs<-C
  
  Ws<-lp (direction = "min", f_obj, f_con, f_dir, f_rhs)
  wmin<-Ws$solution
  Emin=t(wmin)%*%E
  
  # etape 2 trouver L' E(Rp) max
  Ws<-lp(direction = "max",f_obj, f_con, f_dir, f_rhs)
  wmax<-Ws$solution
  Emax=t(wmax)%*%E
  
  # etape 3 creer une serie de rentabilité entre E min et E max avec un pas que l'on choisi en fct
  # du nb de point qu'on veut
  nbpoint<-100  # nombre d'iteration pour la frontiere
  Ebar<-seq(Emin,Emax,(Emax-Emin)/(nbpoint-1) )
  std<-rep(0,nbpoint)
  std[1]<-sqrt(wmin%*%VCV%*%wmin*freq)
  std[nbpoint]<-sqrt(wmax%*%VCV%*%wmax*freq)
  
  
  # etape 4 minimer la variance pour chaque valeur de la série de rentabilité qu'on vient de créer
  # voir l'aide pour solveQP pour optimiser les fonction quadratique
  Dmat<-VCV
  dvec<-rep(0,N)
  A<- rbind(E,rep(1,N),Ui,-Ui)
  bvec<-c(0,1,const[,1],-const[,2])
  for (i in 2:(nbpoint-1)) {
    bvec[1]<-Ebar[i]
    S<-solve.QP(Dmat,dvec,t(A),bvec,meq = 2)
    W<-S$solution
    Ebar[i]<-t(W)%*%E
    std[i]<-sqrt(t(W)%*%VCV%*%W*freq)
    
  }
  return(data.frame(cbind(Ebar,std)))
}

FNprtfcarac<-function(w,ER,VCV){# w: poids portefeuille ; ER rendements annualisé des actifs ; VCV : matrice de variance-covariance
  Ebar<-t(w)%*%ER
  std<-sqrt(t(w)%*%VCV%*%w*freq)
  return(data.frame(cbind(Ebar,std)))
}

graphfronteff <- function(fronteffcarac,prtfcarac) {
  return(ggplot(fronteffcarac)+geom_point(aes(std,Ebar))+geom_point(aes(X2,X1),data = prtfcarac))
}

graphevolprix100 <- function(Pt100) {
  matplot(Pt100,type = "l")
  legend("topleft",c("CAC40","equipondéré","sous evalué","surevalué"),col=c(1,2,3,4),lty=c(1,1,1,1))
  title("Evolution des prix des différentes stratégies")
}



MAIN <- function(actifs,chxopt,geom) {
  
  N<-length(actifs)
  Ptmain<-Pt_mat[,actifs]
  Rtmain<-Rt_mat[,actifs]
  VCV<-VCV_mat[actifs,actifs]
  const<-cbind(rep(0,N),rep(0.15,N))
  
  if (geom=="arithmétiques") {
    ERmain<-ER[actifs]
    ERbench<-ERm
  }else{
    ERmain<-ERg[actifs]
    ERbench<-ERmg
  }
  
  CAPM<-CAPM_estim(Rtmain,Rf,Rtbench_mat,freq,ERmain,ERbench,N)
  
  if (chxopt=="minvar") {
    w<-portf_minivar(Rtmain,freq,ERmain,N)
  }else{
    if (chxopt=="max sharpe") {
      w<-portf_tangent(Rtmain,freq,ERmain,Rf,N)
    }else{
      if (chxopt=="max info") {
        w<-portf_maxinfo(CAPM[,1],CAPM[,3],N)
      }else{
        if (chxopt=="min tracking error") { #COMPLETER VERIFIER CEST LAQUELLE
          w<-1
        }else{
          if (chxopt=="stock picking") {  # COMPLETER SOUS EVAL SUR EVAL
            w<-1
          }else{
            if (chxopt=="équipondéré") {
              w<-portf_equi(N)
            }else{
              if (chxopt=="max alpha") {  ### COMPLETER METHODE ALPHA
                w<-1
              }
            }
          }
        }
      }
    }
  }
  
  fronteffcarac<-frontiereefficiente(Ptmain,Rtmain,freq,const,N,VCV)
  
  Rtprtf<-rentabiliteportf(w,Rtmain)
  Ptprtf<-prixportf100(Rtprtf)
  caracprtf<-FNprtfcarac(w,ERmain,VCV)
  pt100<-cbind(prixportf100(Rtbench_mat),Ptprtf)
  return(list(w,Ptprtf,Rtprtf,caracprtf,pt100,fronteffcarac))
}

If you now run this you'll see that it work flawlessly :

actifs<-c(1:7)
 chxopt<-"minvar"
 geom<-"arithmétiques"
 MAIN(actifs,chxopt,geom)->test
 test[[1]]

then I want to incorporate this to a shiny app and I need it to be reactive and change whenever the user change the inputs so I need to use reactive() but it seems to mess up and i can get to plot my results too :


library(shiny)
library(DT)
library(tidyverse)

###################################
# utilisateur interface 
###################################

# Define UI for application that draws a histogram
ui <- fluidPage(

    # Application title
    titlePanel("Optimisation de portefeuille"),

    # Sidebar with a slider input for number of bins 
    sidebarLayout(
        sidebarPanel(                                # BOUTONS DU COTE
            # METHODE
            selectInput("chxOpt", label = "méthode d'optimisation :",
                        choices = c("minvar", "max sharpe", "max info", "min tracking error","stock picking","équipondéré")),
            # POIDS MAX
            sliderInput("maxPoids", label = " poids maximum des actifs:",
                        min = 0, max = 100, value = 100,post = "%", step = 1),
            # FRAIS DE MANAGEMENT
            sliderInput("managefee", label = "frais de gestion :",
                        min = 0, max = 100, value = 0,post = "%", step = 1),
            # FRAIS DE SURPERFORMANCE
            sliderInput("perffee", label = " frais de surperformance :",
                        min = 0, max = 100, value = 0,post = "%", step = 1),
            # RENDEMENTS ANNUALISE
            selectInput("geom","rendements annulalisés :",c("géométriques","arithmétiques"),selected = "arithmétiques"),
            # VENTE A DECOUVERTE
            selectInput("longshort"," autoriser la vente à découverte :",c("long only","longshort"),selected = "longshort")
        ),

                        # RESULTATS 
        mainPanel(
            tabsetPanel(type = "tabs",
                              tabPanel("Actifs",checkboxGroupInput("actifs","choissisez vos actifs",choiceNames = c("Credit Agricole", "Teleperformance", "Hermes", "Safran", "Air Liquide", 
                                                                                                                    "Carrefour", "TotalEnergies", "L'oreal", "Bouygues", "Sanofi", 
                                                                                                                    "Axa", "Danone", "Pernod Ricard", "Lvmh", "Michelin", "Thales", 
                                                                                                                    "Kering", "EssilorLuxottica", "Schneider Electric", "Veolia Environ.", 
                                                                                                                    "Saint Gobain", "CapGemini", "Vinci", "Vivendi", "Publicis Groupe", 
                                                                                                                    "Societe Generale", "Bnp Paribas", "Renault", "Orange", "Engie", 
                                                                                                                    "Alstom", "Legrand SA", "Worldline", "Unibail Rodamco Wes", "Eurofins Scient.", 
                                                                                                                    "Dassault Systemes", "Arcelor Mittal", "Stmicroelectronics", 
                                                                                                                    "Airbus", "Stellantis"),choiceValues = seq(1,40),inline = TRUE,width = 700) ),
                              tabPanel("Plan moyenne/variance", plotOutput("fronteff")),
                              tabPanel("Evolution du prix", tableOutput("evoprix")),
                        tabPanel("Composition du portefeuille", dataTableOutput("poids"))
            )
        )
    )
)

###################################
# server 
###################################

# Define server logic 
server <- function(input, output,session) {

    portefeuille<-reactive(do.call(MAIN,list(input$actifs,input$chxopt,input$geom)))
    #fronteffcarac<-reactive(do.call(frontiereefficiente(input$actifs)))      # POTENTIELLEMENT AJOUTER DES INPUT DE CONTRAINTE

    output$poids<-DT::renderDataTable({as.matrix(input$actifs)}) #({portefeuille()[[1]]})
    output$fronteff <- renderPlot({
        graphfronteff(portefeuille()[[6]],portefeuille()[[4]])
        })
    output$evoprix<-renderPlot(graphevolprix100(portefeuille()[[5]]))
}

# Run the application 
shinyApp(ui = ui, server = server)

What is the proper way to do this ?
Best regards,

2 
library(shiny)

ui <- fluidPage(
  numericInput("inp",label="start num",5),
  numericInput("mb",label="multiply by",4),
  numericInput("aa",label="add this",3),
  verbatimTextOutput("outnum")
)

main <- function(input,multby,addalso){
  input*multby+addalso
}

server <- function(input, output, session) {
  
  myreactiveresults <- reactive({    
    main(input$inp,input$mb,input$aa)  })

  output$outnum <- renderPrint({
    req(myreactiveresults()) })
}

shinyApp(ui, server)
1 Like
3

Thank you for your respond. I recon you didn't use return() for the function so if you were to estimate multiple expressions you would do multiple functions ? If you had multiple estimation will the output be all of them ? And for a plot output how do you select abscissa and ordinate ?

4

Not quite.
The function example has an implicit return. I prefer to keep my code elegant but you can wrap a return on there and see its the same. For multiple returns the typical approach is to return a list object with the multiple components as members of the list.

5

Ok so i was on the right track ! is there a way to inspect elements of the app while it's running to see what is and what is not right ?

6

I use the browser() function to inspect my apps at breakpoints

1 Like
7

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.