有关闪亮仪表板中的反应功能的问题

时间:2019-10-15 04:01:17

标签: r shiny time-series reactive

我有一个数据集DT,其中包含不同时间的不同materialID的价格。我想制作一个带有菜单的闪亮仪表板,我可以选择将用于子集该材料ID的数据集并执行时间序列建模的每个材料ID。最后在仪表板上显示预测曲线。

我已经使用dashoard Page尝试了以下代码,但是当我运行它时,它总是告诉我预测错误:找不到对象'arima1' 警告:eval_tidy错误:找不到对象“ RMP_train1”

DT:日期= {2016-06-01,2016-11-01,2016-9-1,2016-8-1,2016-06-01,2016-11-01,2016-9-1, 2016-8-1} 材料= {50210452,50210452,50210452,50210452,50224661,50224661,50224661,50224661} UnitPrice = {32,45,38,35,111,112,113,114}

我认为也许我以不适当的方式使用了反应功能。有人可以帮我吗?提前非常感谢您!

material_list <-unique(DT$Material)
newmaterial_list <- as.list(material_list) %>%
  set_names(as.character(material_list))

ui <- dashboardPage(
  dashboardHeader(
    title = "Material Price Dashboard",
    titleWidth = 200
  ),
  dashboardSidebar(
    selectInput(
      inputId = "materialID",
      label = "Material",
      choices = newmaterial_list,
      selected = "50224661",
      selectize = FALSE
    ),

    actionLink("remove", "Remove detail tabs")
  ),

  dashboardBody(
    fluidRow(
      box(plotOutput("plot1", height = 300)),

      box(plotOutput("plot2", height = 300))
    )
  )
)
server <- function(input, output) {


  #----------------------------------------------------------
  aa<-group_by(DT,Material,Date) 
  # Carrier code as the value
  #-------------------------------------------------
  reactive({
    BB=subset(aa, Material==input$materialID)
    bb<-group_by(BB,Date)

    bb=dplyr::arrange(bb, Date)
  #summary(bb)
  #remove the outliers

  # boxplot(bb$UnitPrice, plot=FALSE)$out

   outliers <- boxplot(bb$UnitPrice, plot=FALSE)$out
   if (length(outliers)!=0) 

    #ab=bb[which(bb$UnitPrice %in% outliers),]
   {bb=bb[-which(bb$UnitPrice %in% outliers),]}
  bb=dplyr::arrange(bb, Date)

   bb=bb %>% 
      group_by(ymd(Date)) %>%
      summarise(mean = sprintf("%0.2f",mean(UnitPrice, na.rm = TRUE)))

  #bb$`ymd(Date)`=reactive(as.Date(bb$`ymd(Date)`,format='%Y%m%d'))

   bb$mean=as.numeric(bb$mean)

   colnames(bb)=c('Date','UnitPrice')

  #bb<-bb[!duplicated(bb[c('Date')]),]

  RMP<-data.table(bb$Date,bb$UnitPrice)
  colnames(RMP)=c("Date","Price")
  firstDate <- head(RMP$Date, 1)
  lastDate <- tail(RMP$Date, 1)
  allDates <- data.frame(Date = seq.Date(firstDate, lastDate, by = 'month'))


  RMP <- merge(RMP, allDates, by = 'Date', all = TRUE)
  #-----------------------------------------------

  #-------------------------------------------------------
  library(stinepack)
  RMP$Price <- na.stinterp(RMP$Price, along = RMP$Date)

  #--------------------------------------------------------
  #modeling part
  arima1 <- auto.arima(as.ts(RMP$Price))
  #arima1
  #train_index <- round(0.85*nrow(RMP))
  train_index <- nrow(RMP)-3
  n_total <- nrow(RMP)
  RMP_train1 <-RMP[1:(train_index),]
  RMP_test <- RMP[(train_index+1):n_total,]
  predicted <- numeric(n_total-train_index)


  for (i in 1:(n_total-train_index)) {
    RMP_train <- RMP[1:(train_index-1+i),]
    arima_model <- auto.arima(as.ts(RMP_train$Price))
    pred <- forecast(arima_model, 1)
    predicted[i] <- pred$mean
  }
  })


  output$plot1 <- renderPlot({
    #Preidction plot
    future = forecast(arima1, h = 3)
    plot(future)

  })
  output$plot2 <- renderPlot({
    df_pred <- tibble(obs = c(RMP_train1$Price, RMP_test$Price), 
                      predicted = c(RMP_train1$Price, predicted), 
                      time = RMP$Date) 

    ggplot(gather(df_pred, obs_pred, value, -time) %>% 
             mutate(obs_pred = factor(obs_pred, levels = c("predicted", "obs"))), 
           aes(x = time, y = value, col = obs_pred, linetype = obs_pred)) +
      geom_line() +
      xlab("") + ylab("") +
      scale_color_manual(values=c("black", "hotpink")) +
      scale_linetype_manual(values=c(2, 1)) +
      scale_x_date(date_labels = "%y %b", date_breaks = "2 month") +
      theme_bw() + theme(legend.title = element_blank(),
                         axis.text.x  = element_text(angle=45, vjust=0.5))
  })}


shinyApp(ui, server)

我希望有一个带有菜单的仪表板,我可以选择DT中存在的每个物料ID,并且该物料ID的价格预测可以在绘图中交互显示。

但是目前我有错误

警告:预测错误:找不到对象'arima1'

0 个答案:

没有答案