Shiny reactive not returning ggplot input from another function

Question

I am developing a Shiny app to run ARIMA modeling on a data set and subsequently present the output in the form of graphs and textual summary. The output is meant to be interactive in the sense that the user should be able to select the object from the data set on which this model will run.

Server.R code -

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" is the input variable which will let the user select the object from the database. The primary key to identify it is ID.

ui.R code referencing "select_ID" -

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

Note: branch$ID is just a copy of the data set I will run the regression on. branch$ID just takes the primary key (ID) to populate a drop down list for the user to select the input "select_ID"

The data manipulation, regression, and plotting is done in a custom function, the code of which is below -

  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)

}

Now, the get_my_plot function, when run individually, will return the ggplot. However, when I run the app itself, I don't see any output. What can I do here?

Additionally, along with returning a ggplot graph from the get_my_plot function, can I also return a text output? I would like to return a summary() and accuracy() for the regression models. If so, how can I reference these individually to textOutput calls in the server?

Many thanks!

What does your question have to do with "machine-learning" or "artificial-intelligence"? — pogibas
@StéphaneLaurent Yes, that's what I was using. Copied the older version it seems. Anyway, this isn't the issue as the get_my_plot is returning the ggplot but myreactive_plot isn't. — Siddharth Pandit

sanyi sanyi · Accepted Answer · 2017-12-16T22:05:01

The additional issue can be solved by returning list of different kind of elements.

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

And call them separately by their index in the server part. e.g.:

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]]
    })

Shiny reactive not returning ggplot input from another function

1 Answers