R блестящее приложение не запускает функцию сервера - PullRequest
Новая
       84

R блестящее приложение не запускает функцию сервера

0 голосов
/ 13 июля 2020

Я пытался реализовать shinyApp из кода, который я нашел в «Воспроизводимых финансах с R». В приведенном ниже коде отображается только страница пользовательского интерфейса, но не функция сервера. Я думаю, что функция сервера должна работать, но я не знаю почему. Может ли кто-нибудь помочь мне понять, что не так с функцией сервера и почему я вижу, что пользовательский интерфейс появляется только при запуске приложения? 

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) '''

1 Ответ

0 голосов
/ 22 июля 2020

Я заменил eventReactive на observeEvent и использовал reactiveVal вместо portfolio_returns_byhand. Это обходной путь, и я также не понимаю, почему eventReactive не работает должным образом. cat показывает в консоли, что кнопка теперь учитывается. Пожалуйста, проверьте, у меня нет неограниченного ключа API, и я получаю предупреждение / ошибку от 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)
...