demo/shiny_TS/server.R

shinyServer(
  function(input, output, session) {
  
  # Initialize
  # rawData <- eventReactive(input$csvFile, {
  #   read.csv(input$csvFile$datapath, row.names = NULL)
  # })
  
  rawData <- eventReactive(input$test, {
    read.csv("www/test.csv", row.names = NULL)
  })
  
  output$rawData <- renderDataTable(
    rawData() %>% head(),
    options = list(paging = FALSE,
                   searching = FALSE)
    )
  
  # Reactive input
  output$var.1 <- renderUI({
    cols = mapply(list, names(rawData()))
    selectInput("var.1", "Y :", choices = cols, selected = 1)
  })
  
  output$var.2 <- renderUI({
    cols = mapply(list, names(rawData()))
    selectInput("var.2", "X :", choices = cols, multiple = TRUE, selected = 1)
  })
  
  output$var.3 <- renderUI({
    cols = mapply(list, names(rawData()))
    selectInput("var.3", "X :", choices = cols, multiple = FALSE, selected = 1)
  })
  
  output$var.temp <- renderUI({
    cols = mapply(list, names(rawData()))
    selectInput("var.temp", "Time :", choices = c(cols, "None"), selected = "None")
  })

  # Observe input
  observeEvent(input$var.1, {
    plotlyProxy("plot", session) %>% 
      plotlyProxyInvoke("relayout", list(x = input$var.1))
  })
  
  observeEvent(input$var.temp, {
    plotlyProxy("plot", session) %>% 
      plotlyProxyInvoke("relayout", list(y = input$var.temp))
  })
  
  observeEvent(input$var.2, {
    plotlyProxy("plot", session) %>% 
      plotlyProxyInvoke("relayout", list(x = input$var.2))
  })
  
  observeEvent(input$var.3, {
    plotlyProxy("plot", session) %>% 
      plotlyProxyInvoke("relayout", list(x = input$var.2))
  })

# Y ############################################################################
  
  # Plot 
  output$plot.corr <- renderPlotly({
    dt = rawData() %>% 
      add_time(input$var.temp) %>% 
      dplyr::select(x = input$var.1, y = input$var.3, time = temps) %>% 
      adjust_season(input$seasonal.adjustment, input$timestamp) %>% 
      add_trend(input$trend, input$auto.trend, input$trend.order, input$timestamp)
    
    pl = bind_cols(lag = as.factor(ccf(dt$x, dt$y)$lag),
                   ACF = as.numeric(ccf(dt$x, dt$y)$acf)) %>% 
      plot_ly(x = ~ lag, y = ~ ACF, type = 'bar', name = "Corrélation croisée")
  })
  
  # Plot 
  output$plot <- renderPlotly({
    dt = rawData() %>% 
      add_time(input$var.temp) %>% 
      dplyr::select(x = input$var.1, time = temps) %>% 
      adjust_season(input$seasonal.adjustment, input$timestamp) %>% 
      add_trend(input$trend, input$auto.trend, input$trend.order, input$timestamp)
    
    if(input$acf == FALSE & input$pacf == FALSE){
      dt %>%
        plot_ly(x = ~ time, y = ~ x, type = 'scatter', mode = 'lines',
                name = 'Realisation', hoverinfo = 'text') %>%
        layout(title = paste("Y :", input$var.1),
               yaxis = list(title = "")) %>%
        add_plot_trend(input$trend, input$auto.trend, input$trend.order)
    }
    else if(input$acf == TRUE & input$pacf == FALSE){
      bind_cols(lag = as.factor(acf(dt$x)$lag),
                ACF = as.numeric(acf(dt$x)$acf)) %>%
        plot_ly(x = ~ lag, y = ~ ACF, type = 'bar', name = "ACF")
    }
    else if(input$acf == FALSE & input$pacf == TRUE){
      bind_cols(lag = as.factor(pacf(dt$x)$lag),
                PACF = as.numeric(pacf(dt$x)$acf)) %>%
        plot_ly(x = ~ lag, y = ~ PACF, type = 'bar', name = "PACF")
    }
    else if(input$acf == TRUE & input$pacf == TRUE){
      subplot(
        bind_cols(lag = as.factor(acf(dt$x)$lag),
                  ACF = as.numeric(acf(dt$x)$acf)) %>%
          plot_ly(x = ~ lag, y = ~ ACF, type = 'bar', name = "ACF"),
        bind_cols(lag = as.factor(pacf(dt$x)$lag),
                  ACF = as.numeric(pacf(dt$x)$acf)) %>%
          plot_ly(x = ~ lag, y = ~ ACF, type = 'bar', name = "PACF")
      )
    }
  })
  
  # Plot 
  output$gplot <- renderPlot({
    dt = rawData() %>% 
      add_time(input$var.temp) %>% 
      dplyr::select(x = input$var.1, time = temps) %>% 
      adjust_season(input$seasonal.adjustment, input$timestamp) %>% 
      add_trend(input$trend, input$auto.trend, input$trend.order, input$timestamp) 
    
    nnetar(dt$x) %>%
      forecast::forecast(h = input$h) %>% 
      autoplot() +
      theme_minimal() + 
      labs(x = NULL, y = NULL)
  })
  
  # Plot VAR
  output$mplot <- renderPlot({
    dt = rawData() %>% 
      add_time(input$var.temp) %>% 
      dplyr::select(x = input$var.1, input$var.2, time = temps) %>% 
      adjust_season(input$seasonal.adjustment, input$timestamp) %>% 
      add_trend(input$trend, input$auto.trend, input$trend.order, input$timestamp) %>% 
      dplyr::select(-time)
    
    VAR(dt[, -ncol(dt)]) %>% 
      irf(n.ahead = input$ahead) %>% 
      plot()
  })
  
# X ############################################################################
  
  output$plot.x = renderPlotly({
    # Initialize
    dt = list()
    pl = list()
    # Loop 
    for(i in 1:length(input$var.2)) {
      dt[[i]] = rawData() %>% 
        add_time(input$var.temp) %>% 
        dplyr::select(x = input$var.2[i], time = temps) %>% 
        adjust_season(input$seasonal.adjustment, input$timestamp) %>% 
        add_trend(input$trend, input$auto.trend, input$trend.order, input$timestamp) 
    
      if(input$acf.x == FALSE & input$pacf.x == FALSE){
        pl[[i]] = dt[[i]] %>% 
          plot_ly(x = ~ time, y = ~ x, type = 'scatter', mode = 'lines',
                  name = input$var.2[i], hoverinfo = 'text') %>% 
          layout(title = paste("X :", paste(input$var.2)),
                 yaxis = list(title = ""),
                 legend = list(orientation = "h", xanchor = "center", x = .5)) %>% 
          add_plot_trend(input$trend, input$auto.trend, input$trend.order)
      }
      else if(input$acf.x == TRUE & input$pacf.x == FALSE){
        pl[[i]] = bind_cols(lag = as.factor(acf(dt[[i]]$x)$lag),
                            ACF = as.numeric(acf(dt[[i]]$x)$acf)) %>%
          plot_ly(x = ~ lag, y = ~ ACF, type = 'bar', name = paste(input$var.2[[i]], "ACF")) %>% 
          layout(yaxis = list(title = ""),
                 legend = list(orientation = "h", xanchor = "center", x = .5))
      }
      else if(input$acf.x == FALSE & input$pacf.x == TRUE){
        pl[[i]] = bind_cols(lag = as.factor(pacf(dt[[i]]$x)$lag),
                            PACF = as.numeric(pacf(dt[[i]]$x)$acf)) %>%
          plot_ly(x = ~ lag, y = ~ PACF, type = 'bar', name = paste(input$var.2[[i]], "PACF")) %>% 
          layout(yaxis = list(title = ""),
                 legend = list(orientation = "h", xanchor = "center", x = .5))
      }
      else if(input$acf.x == TRUE & input$pacf.x == TRUE){
        pl[[i]] = subplot(shareX = TRUE, nrows = 2, 
          bind_cols(lag = as.factor(acf(dt[[i]]$x)$lag),
                    ACF = as.numeric(acf(dt[[i]]$x)$acf)) %>%
            plot_ly(x = ~ lag, y = ~ ACF, type = 'bar', name = paste(input$var.2[[i]], "ACF")) %>% 
            layout(yaxis = list(title = ""),
                   legend = list(orientation = "h", xanchor = "center", x = .5)),
          bind_cols(lag = as.factor(pacf(dt[[i]]$x)$lag),
                    ACF = as.numeric(pacf(dt[[i]]$x)$acf)) %>%
            plot_ly(x = ~ lag, y = ~ ACF, type = 'bar', name = paste(input$var.2[[i]], "PACF")) %>% 
            layout(yaxis = list(title = ""),
                   legend = list(orientation = "h", xanchor = "center", x = .5))
        )
      }
    }
    # Plot all 
    subplot(pl)
  })
  
  output$gplot.x = renderPlot({
    # Initialize
    dt = list()
    pl = list()
    # Loop 
    for(i in 1:length(input$var.2)) {
      dt[[i]] = rawData() %>% 
        add_time(input$var.temp) %>% 
        dplyr::select(x = input$var.2[i], time = temps) %>% 
        adjust_season(input$seasonal.adjustment, input$timestamp) %>% 
        add_trend(input$trend, input$auto.trend, input$trend.order, input$timestamp) 
      
        pl[[i]] = nnetar(dt[[i]]$x) %>%
          forecast::forecast(h = input$h) %>% 
          autoplot() + 
          theme_minimal() + 
          labs(x = NULL, y = NULL)
    }
    # Plot all 
    do.call("grid.arrange", c(pl, ncol = length(pl)))
  })
  
})
AlexisMayer/toolbox documentation built on Aug. 25, 2020, 3:56 p.m.