闪亮的反应没有从另一个函数返回ggplot输入

Question

我正在开发一个 Shiny 应用程序来对数据集运行 ARIMA 建模，然后以图形和文本摘要的形式呈现输出。输出是交互式的，因为用户应该能够从运行该模型的数据集中选择对象。

Server.R 代码 -

server <- function(input, output) {
  my_data <-fread("Branch_Final_Cleaned.csv")

  myreactive_plot<-reactive({
    get_my_plot(input$select_ID, my_data)

  })

   output$branch_regression_plot <- renderPlot({
     myreactive_plot()
   })
}

“select_ID”是让用户从数据库中选择对象的输入变量。识别它的主键是 ID。

ui.R 代码引用“select_ID”-

selectInput(
                   inputId = "select_ID",
                   "Select Branch ID",
                   selected = "106841",
                   sort(unique(branch$ID))
                 )

注意：branch$ID 只是我将运行回归的数据集的副本。 branch$ID 只使用主键 (ID) 填充下拉列表，供用户选择输入“select_ID”

数据操作、回归和绘图是在一个自定义函数中完成的，其代码如下 -

  get_my_plot <- function(id, branch_analysis) {

  branch_analysis <- fread("Branch_Final_Cleaned.csv")
  data_branch_analysis <- data.table(branch_analysis)

  data_branch_analysis<-(data_branch_analysis[ID==id])[order(DATE)]
  data_branch_analysis[,NDATE:=as.Date(DATE,"%Y.%m.%d")]
  data_branch_analysis[,L_AVG_AGE:=shift(AVG_AGE,1)]
  data_branch_analysis[,L_AVG_WAGE:=as.numeric(shift(AVG_WAGE,1))]
  data_branch_analysis[,WD:=format.Date(NDATE,"%a")]
  data_branch_analysis[,time:=as.numeric(NDATE-min(data_branch_analysis$NDATE))]
  data_branch_analysis[is.na(AGE_0_17),AGE_0_17:=0]
  data_branch_analysis[is.na(AGE_18_25),AGE_18_25:=0]
  data_branch_analysis[is.na(AGE_26_35),AGE_26_35:=0]
  data_branch_analysis[is.na(AGE_36_45),AGE_36_45:=0]
  data_branch_analysis[is.na(AGE_46_55),AGE_46_55:=0]
  data_branch_analysis[is.na(AGE_56_65),AGE_56_65:=0]
  data_branch_analysis[is.na(AGE_66_99),AGE_66_99:=0]
  data_branch_analysis[is.na(W3_7),W3_7:=0]
  data_branch_analysis[is.na(W7_14),W7_14:=0]
  data_branch_analysis[is.na(W14_21),W14_21:=0]
  data_branch_analysis[is.na(W21_99),W21_99:=0]
  data_branch_analysis[,L_AGE_0_17:=shift(AGE_0_17,1)]
  data_branch_analysis[,L_AGE_18_25:=shift(AGE_18_25,1)]
  data_branch_analysis[,L_AGE_26_35:=shift(AGE_26_35,1)]
  data_branch_analysis[,L_AGE_36_45:=shift(AGE_36_45,1)]
  data_branch_analysis[,L_AGE_46_55:=shift(AGE_46_55,1)]
  data_branch_analysis[,L_AGE_56_65:=shift(AGE_56_65,1)]
  data_branch_analysis[,L_AGE_66_99:=shift(AGE_66_99,1)]
  data_branch_analysis[,L_W3_7:=shift(W3_7,1)]
  data_branch_analysis[,L_W7_14:=shift(W7_14,1)]
  data_branch_analysis[,L_W14_21:=shift(W14_21,1)]
  data_branch_analysis[,L_W21_99:=shift(W21_99,1)]

  fit1<-lm(data=data_branch_analysis,VISITOR_NUM~0+time+WD+L_W3_7+L_W7_14+L_W14_21+L_W21_99+L_AVG_AGE+L_AVG_WAGE+L_AGE_0_17+L_AGE_18_25+L_AGE_26_35+L_AGE_36_45+L_AGE_46_55+L_AGE_56_65+L_AGE_66_99)
  bestm<-step(fit1, trace = FALSE)

  ntrain=199

  data_branch_analysis_train<-head(bestm$model,ntrain)

  data_reg<-copy(data.table(bestm$model))
  data_reg[,MON:=ifelse(WD=="Mon",1,0)]
  data_reg[,TUE:=ifelse(WD=="Tue",1,0)]
  data_reg[,WED:=ifelse(WD=="Wed",1,0)]
  data_reg[,THU:=ifelse(WD=="Thu",1,0)]
  data_reg[,FRI:=ifelse(WD=="Fri",1,0)]
  data_reg$WD<-NULL
  data_reg$VISITOR_NUM<-NULL
  x_reg<-head(data_reg,ntrain)


  fit2<-auto.arima(data_branch_analysis_train$VISITOR_NUM,max.order=30,xreg=as.matrix(x_reg))


  #nrow(data_branch_analysis)-(ntrain+1)
  new_x<-tail(data_reg,nrow(data_branch_analysis)-(ntrain+1))
  fore2<-forecast(fit2,xreg=as.matrix(new_x))

  g <-
    ggplot()+geom_line(aes(x=data_branch_analysis$NDATE,y=data_branch_analysis$VISITOR_NUM,col="original"))+
    geom_line(aes(x=data_branch_analysis$NDATE[2:(ntrain+1)],y=fit2$fitted,col="train"))+
    geom_line(aes(x=data_branch_analysis$NDATE[(ntrain+2):nrow(data_branch_analysis)],y=fore2$mean,col="test"))

  return(g)

}

现在，get_my_plot 函数在单独运行时将返回 ggplot。但是，当我运行应用程序本身时，我看不到任何输出。我可以在这里做什么？

此外，除了从 get_my_plot 函数返回 ggplot 图形之外，我还可以返回文本输出吗？我想为回归模型返回一个 summary() 和 accuracy() 。如果是这样，我如何将这些单独引用到服务器中的 textOutput 调用？

非常感谢！

Answer 1

可以通过返回不同类型元素的列表来解决附加问题。

return(list(g, 
            summary(fit1), 
            summary(fit2), 
            accuracy(fit1), 
            accuracy(fit2)
      )

并通过它们在服务器部分的索引分别调用它们。 例如：

myreactive_plot <- reactive({
    get_my_plot(input$select_ID, my_data)[[1]]
    })

myreactive_fit1_summary <- reactive({
    get_my_plot(input$select_ID, my_data)[[2]]
    })