【问题标题】:R shiny application not running the server functionR闪亮的应用程序没有运行服务器功能
【发布时间】:2020-11-02 18:54:13
【问题描述】:

我试图从“Reproducible Finance with R”中找到的代码实现 shinyApp。下面的代码只显示了 UI 页面,而不是服务器功能。我认为服务器功能应该可以工作,但我不知道为什么。有人可以帮助我了解服务器功能出了什么问题,以及为什么我只在运行应用程序时看到 UI 出现?

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

【问题讨论】:

  • 闪亮应用的可见部分仅是用户界面。服务器作用于 UI。您对服务器还有什么期望?
  • 嗨 Waldi,很抱歉让我澄清一下。我可以清楚地看到 UI 部分,但是当我点击提交按钮时没有任何反应。我不明白为什么会这样。

标签: r shiny shinyapps shiny-reactivity


【解决方案1】:

我将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)
 

【讨论】:

  • 谢谢瓦尔迪。我又试了一次,还是不行。我按照指定替换了代码,但收到以下错误:data 必须是数据框,或其他可被fortify() 强制转换的对象,而不是具有 uneval 类的 S3 对象您是否不小心将aes() 传递给data争论?我尝试用 %>% data_frame() 传递这些图,只要它说 output$plot % data_frame() %>% ggplot ,这仍然不起作用。
  • 正如我在回答中解释的那样,我确保gobt 触发了反应,您可以在控制台中看到这一点。但我无权访问 Quandl,因此无法使用真实数据进行测试。为了进一步调试,我首先要确保portfolio_returns_byhand() 包含一个数据框:您可以通过使用saveRDS 来保存res 中间结果来进行检查。
  • 我使用 as.data.frame() 将价格对象传递给数据框,但我仍然获得了相同的结果。我什至使用了替换 Quandl API 密钥的代码并得到了相同的结果:symbols % rename(asset= symbol) 价格% select(date, assets,adjusted) %>% pivot_wider(names_from = assets, values_from =adjusted) %>% as.data.frame()
  • 您能否尝试创建一个MRE 的问题:我认为最初的问题已得到解答 - 服务器功能正在运行,但您仍有未解决的子问题。
猜你喜欢
  • 1970-01-01
  • 2017-07-04
  • 1970-01-01
  • 2018-07-29
  • 2016-05-23
  • 2013-07-08
  • 2018-09-03
  • 1970-01-01
  • 2021-10-08
相关资源
最近更新 更多