Вопрос о реактивной функции в блестящей приборной панели - PullRequest
0 голосов
/ 15 октября 2019

У меня есть набор данных DT, включая цену для разных ID материалов в разное время. Я хотел бы создать блестящую панель инструментов с меню, в котором я мог бы выбрать каждый идентификатор материала, который будет использоваться для поднабора наборов данных для этого идентификатора материала и выполнения моделирования временных рядов. Наконец, представьте прогнозную кривую на приборной панели.

Я пробовал следующий код, используя страницу dashoard, но при запуске он продолжает сообщать мне, что Ошибка в прогнозе: объект '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} Material = {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, и прогноз на цену этого идентификатора материала может показатьв интерактивном режиме на графиках.

Но в настоящее время у меня есть ошибка

Предупреждение: ошибка в прогнозе: объект 'arima1' не найден

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...