简体   繁体   中英

R shiny application not running the server function

I was trying to implement the shinyApp from code that I found in " Reproducible finance with R". The code below only shows the UI page and not the server function. I think the server function should work but I don't know why. Could someone help me understand what is wrong with the server function and why I only see the UI appear when I run the app?

ui<-fluidPage(titlePanel("Portfolio Returns"),

   
sidebarPanel(fluidRow(
        column(6,
         textInput("stock1", "Stock 1", "SPY")),
      column(5,numericInput("w1", "Portf. %", 25, min =1, max = 100))),
     fluidRow(
    column(6,
           textInput("stock2", "Stock 2", "EFA")),
    column(5,numericInput("w1", "Portf. %", 25, min =1, max = 100))),
  
  fluidRow(
    column(6,
           textInput("stock3", "Stock 3", "IJS")),
    column(5,numericInput("w1", "Portf. %", 20, min =1, max = 100))),
  
  fluidRow(
    column(6,
           textInput("stock4", "Stock 4", "EEM")),
    column(5,numericInput("w1", "Portf. %", 20, min =1, max = 100))),
  
  fluidRow(
    column(6,
           textInput("stock5", "Stock 5", "AGG")),
    column(5,numericInput("w1", "Portf. %", 10, min =1, max = 100))),
  
  fluidRow(
    column(7,
      dateInput("date","Starting Date", "2013-01-01", format = "yyyy-mm-dd"))),
    
  fluidRow(
    column(6,
           selectInput("rebalance", "rebal freq",
                       c("Yearly" = "years",
                         "Monthly"="months",
                         "Weekly"="weeks")))),
  actionButton("go", "Submit")))


mainPanel(tabsetPanel(
  tabPanel("Plot", plotOutput("plot")),
  tabPanel("plot2", plotOutput("plot2")),
  tabPanel("plot3", plotOutput("plot3"))
  )
)

# Define server logic required to draw a histogram
server <- function(input, output) {
  

   portfolio_returns_byhand<- eventReactive(input$go, {
 
 #####Maybe problem here###########################################
 symbols <- c(input$stock1, input$stock2, input$stock3,input$stock4, input$stock5)
 
 
 prices <- symbols %>%
   tq_get(get          = "quandl",
          from         = "2007-01-01",
          to           = "2020-05-31",
          transform    = "rdiff",
          collapse     = "monthly",
          column_index = 11) %>%
   rename(monthly.returns = adj.close)
 prices 
 
 #prices <- read_csv("Reproducible Finance.csv", 
  #                  col_types = cols(date = col_date(format = "%m/%d/%Y"))) %>% tk_xts(date_var = date) 

 w <- c(input$w1/100,input$w2/100,input$w3/100,input$w4/100,input$w5/100)
 
 asset_returns_long <- 
   prices %>% to.monthly(indexAt = "last", OHLC=FALSE) %>% tk_tbl(perserve_index = TRUE, rename_index = "date") %>%
      gather(asset, returns,-date) %>% group_by(asset) %>% mutate(returns = (log(returns)- log(lag(returns))))
 
 portfolio_returns_byhand<- asset_returns_long %>% 
   tq_portfolio(assets_col = asset,
                returns_col = returns,
                weights = w,
                col_rename= "returns")
 
   })
   
   output$plot <- renderPlot({
     portfolio_returns_byhand() %>% ggplot(aes(x = returns))
      ggplot(aes(x = return)) + geom_histogram(alpha = 0.25, binwidth = .01, fill = "cornflowerblue")
   })
   
   output$plot2 <- renderPlot({
      portfolio_returns_byhand()%>% ggplot(aes(x = returns)) + geom_density(
        size=1,
        color= "blue"
      )
    })   
   
   output$plot3 <- renderPlot({
        portfolio_returns_byhand() %>% ggplot(aes(x = returns)) + geom_histogram(alpha = 0.25,binwidth = 0.01, fill = "blue")+
          geom_density(
            size=1,
            color = "red")
      })
   
   
}

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

I replaced eventReactive by observeEvent and used a reactiveVal for portfolio_returns_byhand .
This is a workaround and I also don't understand why eventReactive doesn't work as expected.
cat shows in the console that the button is now taken into account.
Please test, I don't have an unrestricted API key and get a warning/error from Quandl.

library(tidyquant)
library(shiny)


ui<-fluidPage(titlePanel("Portfolio Returns"),
              
              
              sidebarPanel(fluidRow(
                column(6,
                       textInput("stock1", "Stock 1", "SPY")),
                column(5,numericInput("w1", "Portf. %", 25, min =1, max = 100))),
                fluidRow(
                  column(6,
                         textInput("stock2", "Stock 2", "EFA")),
                  column(5,numericInput("w1", "Portf. %", 25, min =1, max = 100))),
                
                fluidRow(
                  column(6,
                         textInput("stock3", "Stock 3", "IJS")),
                  column(5,numericInput("w1", "Portf. %", 20, min =1, max = 100))),
                
                fluidRow(
                  column(6,
                         textInput("stock4", "Stock 4", "EEM")),
                  column(5,numericInput("w1", "Portf. %", 20, min =1, max = 100))),
                
                fluidRow(
                  column(6,
                         textInput("stock5", "Stock 5", "AGG")),
                  column(5,numericInput("w1", "Portf. %", 10, min =1, max = 100))),
                
                fluidRow(
                  column(7,
                         dateInput("date","Starting Date", "2013-01-01", format = "yyyy-mm-dd"))),
                
                fluidRow(
                  column(6,
                         selectInput("rebalance", "rebal freq",
                                     c("Yearly" = "years",
                                       "Monthly"="months",
                                       "Weekly"="weeks")))),
                actionButton("gobt", "Submit")))


mainPanel(tabsetPanel(
  tabPanel("Plot", plotOutput("plot")),
  tabPanel("plot2", plotOutput("plot2")),
  tabPanel("plot3", plotOutput("plot3"))
)
)

# Define server logic required to draw a histogram
server <- function(input, output) {
  

  portfolio_returns_byhand <- reactiveVal()
  observeEvent(input$gobt, {
    cat('Go button pressed\n')
    symbols <- c(input$stock1, input$stock2, input$stock3,input$stock4, input$stock5)
    prices <- symbols %>%
      tq_get(get          = "quandl",
             from         = "2007-01-01",
             to           = "2020-05-31",
             transform    = "rdiff",
             collapse     = "monthly",
             column_index = 11) %>%
      rename(monthly.returns = adj.close)
    prices 
    
    #prices <- read_csv("Reproducible Finance.csv", 
    #                  col_types = cols(date = col_date(format = "%m/%d/%Y"))) %>% tk_xts(date_var = date) 
    
    w <- c(input$w1/100,input$w2/100,input$w3/100,input$w4/100,input$w5/100)
    
    asset_returns_long <- 
      prices %>% to.monthly(indexAt = "last", OHLC=FALSE) %>% tk_tbl(perserve_index = TRUE, rename_index = "date") %>%
      gather(asset, returns,-date) %>% group_by(asset) %>% mutate(returns = (log(returns)- log(lag(returns))))
    
    res <- asset_returns_long %>% 
      tq_portfolio(assets_col = asset,
                   returns_col = returns,
                   weights = w,
                   col_rename= "returns")
    portfolio_returns_byhand(res)
    
  })
  
  output$plot <- renderPlot({
    portfolio_returns_byhand() %>% ggplot(aes(x = returns))
    ggplot(aes(x = return)) + geom_histogram(alpha = 0.25, binwidth = .01, fill = "cornflowerblue")
  })
  
  output$plot2 <- renderPlot({
    portfolio_returns_byhand()%>% ggplot(aes(x = returns)) + geom_density(
      size=1,
      color= "blue"
    )
  })   
  
  output$plot3 <- renderPlot({
    portfolio_returns_byhand() %>% ggplot(aes(x = returns)) + geom_histogram(alpha = 0.25,binwidth = 0.01, fill = "blue")+
      geom_density(
        size=1,
        color = "red")
  })
}

shinyApp(server = server,ui)
 

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM