server.R

# This is the server logic for a Shiny web application.
# You can find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com
#

library(ggplot2)
library(shiny)
library(dygraphs)

shinyServer(

  function(input, output) {

    load_data<-reactive({

      #infie <- 'D:\GitHub\AnalisisSeriesTiempo\cementq.dat'

      inFile <- input$data_serie

      if (input$data_serie == 0){
        return(NULL)
      }
      if (is.null(inFile) == TRUE){
        return(NULL)
      }
      if (input$data_serie != 0){
        anyo <- as.numeric(input$var_anyo)
        mes <- as.numeric(input$var_mes)
        tipo_fq <- as.numeric(input$var_fre_1)
        fq = 4

        # Frecuencia
        # Mensual
        if(tipo_fq == 1)
          fq = 12
        # Trimestral
        if(tipo_fq == 2)
          fq = 4

        data<-ts(scan(inFile$datapath,skip=input$skipper),start=c(anyo,mes),
                 frequency = fq)

        return(data)
      }
    })

    # Print Serie
    #output$plot_serie <- renderPlot({
    #  data<-load_data()
    #  plot(data,main="Serie de tiempo")
    #})
    output$plot_serie <- renderDygraph({
      if (is.null(load_data))
        return(NULL)

      data<-load_data()

      dygraph(data, main="Serie de tiempo")%>% dyRangeSelector()%>%
        dyOptions(stackedGraph = TRUE, axisLabelColor =  "white",
                  colors="yellow")%>%
        dyRoller(rollPeriod = 5)
    })

    # Print Histograma
    output$plot_histograma <- renderPlot({

      inFile <- input$data_serie
      if (is.null(inFile))
        return(NULL)
      else
        data_hist = scan(inFile$datapath)
      #hist(data_hist)
      hist(data_hist, col=35, border="yellow", main="Histograma",
           xlab="Valores", ylab="Frecuencia")
    })

    # Print ACF
    output$plot_acf <- renderPlot({

      inFile <- input$data_serie
      if (is.null(inFile))
        return(NULL)
      else
        data_acf = scan(inFile$datapath)

      #ggAcf(data_acf, ci = 0.95, xlab = "Lag", ylab = "ACF",
      #     main = "Autocorrelacion",
      #     col=35)
      plot(acf(data_acf), ci = 0.95, type = "h", xlab = "Lag", ylab = "ACF",
           main = "Autocorrelacion",
           col=35)
    })

    # Print PACF
    output$plot_pacf <- renderPlot({

      inFile <- input$data_serie
      if (is.null(inFile))
        return(NULL)
      else
        data_pacf = scan(inFile$datapath)

      pacf(data_pacf, main="Autocorrelación Parcial", xlab="Lag", ylab="PACF",
           col=35)

    })

    # Print Resumen
    output$resumen <- renderPrint({

      inFile <- input$data_serie
      if (is.null(inFile))
        return(NULL)
      else
        data_hist = scan(inFile$datapath)
      summary(data_hist)
    })

    # Print Modelo Regresion
    output$plot_reg_mod1 <- renderPlot({

      data <-load_data()

      tipo_mod <- as.numeric(input$var_mod_1)
      tipo_est <- as.numeric(input$var_est_1)
      tipo_pro <- as.numeric(input$var_pro_1)
      y <- ts(data,start=1,frequency=4)

      # Se dejan los ultimos "n" periodos para validación cruzada
      m <- tipo_pro
      T <- length(y)
      yi <- y[1:(T-m)]
      yf <- y[(T-m+1):T]

      # lineal
      t <- seq(1:(T-m))
      # Cuadratico
      t2 <- t*t
      # Cubico
      t3 <- t*t*t
      # Log
      lyi <- log(yi)

      # estimacion modelos
      yest <- mat.or.vec(length(yi),2)

      # variables modelo con estacionalidad
      yi_est = ts(y[1:(T-m)],frequency=4)
      yf_est = ts(y[(T-m+1):T],frequency=4)

      ti = seq(1,length(yi_est))
      ti2 = ti*ti
      ti3 = ti*ti*ti
      It = seasonaldummy(yi_est)
      It.trig = fourier(yi_est,1)


      if(tipo_mod == 1 && tipo_est == 1){
        mod.1 <- lm(yi~t)
        yhat.1 <- fitted(mod.1)

        #plot.ts(t,yi,lwd=3,col='#7164E5',type='o',main='Regresion Lineal Simple')
        #lines(t,yhat.1,col='#535A76',lwd=3)
        #legend("bottomright",c('Original','Regresión Lineal Simple'), lwd=c(3,3,3),col = c('#7164E5','#535A76','black'))

        df <- data.frame(t,yi,yhat.1)

        print(ggplot(df, aes(t, yi, color=Variable))+
                ylab("Valores")+
                xlab("Tiempo")+
                geom_line(aes(t, yi, col="Valores Iniciales"))+
                geom_line(aes(t, yhat.1, col="Valores Ajustados"))+
                ggtitle('Regresion Lineal Simple')+
                theme(plot.title = element_text(hjust = 0.5))+
                theme(legend.position="bottom"))
      }

      if(tipo_mod == 1 && tipo_est == 2){
        mod.1 <- lm(yi_est~ti + It)
        yhat.1 <- mod.1$fitted.values

        #plot(ti,yi_est,lwd=3,col='#7164E5',type='o',main='Regresion Lineal Simple')
        #lines(ti,yhat.1,col='#535A76',lwd=3)
        #legend("bottomright",c('Original','Regresión Lineal Simple'), lwd=c(3,3,3),col = c('#7164E5','#535A76','black'))

        df <- data.frame(t,yi_est,yhat.1)

        print(ggplot(df, aes(t, yi, color=Variable))+
                ylab("Valores")+
                xlab("Tiempo")+
                geom_line(aes(t, yi, col="Valores Iniciales"))+
                geom_line(aes(t, yhat.1, col="Valores Ajustados con Estacionarios Ind."))+
                ggtitle('Regresion Lineal Simple')+
                theme(plot.title = element_text(hjust = 0.5))+
                theme(legend.position="bottom"))
      }

      if(tipo_mod == 1 && tipo_est == 3){
        mod.1 <- lm(yi_est~ti + It.trig)
        yhat.1 <- mod.1$fitted.values

        #plot(ti,yi_est,lwd=3,col='#7164E5',type='o',main='Regresion Lineal Simple')
        #lines(ti,yhat.1,col='#535A76',lwd=3)
        #legend("bottomright",c('Original','Regresión Lineal Simple'), lwd=c(3,3,3),col = c('#7164E5','#535A76','black'))

        df <- data.frame(t,yi_est,yhat.1)

        print(ggplot(df, aes(t, yi, color=Variable))+
                ylab("Valores")+
                xlab("Tiempo")+
                geom_line(aes(t, yi, col="Valores Iniciales"))+
                geom_line(aes(t, yhat.1, col="Valores Ajustados con Estacionarios Trig."))+
                ggtitle('Regresion Lineal Simple')+
                theme(plot.title = element_text(hjust = 0.5))+
                theme(legend.position="bottom"))
      }

      # Print Regresión Cuadrática
      if(tipo_mod == 2 && tipo_est == 1){
        mod.1 <- lm(yi~t + t2)
        yhat.1 <- fitted(mod.1)

        #plot.ts(t,yi,lwd=3,col='#7164E5',type='o',main='Regresion Cuadrática')
        #lines(t,yhat.1,col='#535A76',lwd=3)
        #legend("bottomright",c('Original','Regresión Cuadrática'), lwd=c(3,3,3),col = c('#7164E5','#535A76','black'))

        df <- data.frame(t,yi,yhat.1)

        print(ggplot(df, aes(t, yi, color=Variable))+
                ylab("Valores")+
                xlab("Tiempo")+
                geom_line(aes(t, yi, col="Valores Iniciales"))+
                geom_line(aes(t, yhat.1, col="Valores Ajustados"))+
                ggtitle('Regresion Cuadratica')+
                theme(plot.title = element_text(hjust = 0.5))+
                theme(legend.position="bottom"))
      }

      if(tipo_mod == 2 && tipo_est == 2){
        mod.1 <- lm(yi~ti + ti2 + It)
        yhat.1 <- mod.1$fitted.values

        #plot(ti,yi_est,lwd=3,col='#7164E5',type='o',main='Regresion Cuadratica con Estacionalidad')
        #lines(ti,yhat.1,col='#535A76',lwd=3)
        #legend("bottomright",c('Original','Regresión Cuadratica con Estacionalidad'), lwd=c(3,3,3),col = c('#7164E5','#535A76','black'))

        df <- data.frame(t,yi_est,yhat.1)

        print(ggplot(df, aes(t, yi, color=Variable))+
                ylab("Valores")+
                xlab("Tiempo")+
                geom_line(aes(t, yhat.1, col="Valores Ajustados con Estacionalidad Ind."))+
                geom_line(aes(t, yi, col="Valores Iniciales"))+
                ggtitle('Regresion Lineal Simple')+
                theme(plot.title = element_text(hjust = 0.5))+
                theme(legend.position="bottom"))
      }

      if(tipo_mod == 2 && tipo_est == 3){
        mod.1 <- lm(yi~ti + ti2 + It.trig)
        yhat.1 <- mod.1$fitted.values

        #plot(ti,yi_est,lwd=3,col='#7164E5',type='o',main='Regresion Cuadratica con Estacionalidad')
        #lines(ti,yhat.1,col='#535A76',lwd=3)
        #legend("bottomright",c('Original','Regresión Cuadratica con Estacionalidad'), lwd=c(3,3,3),col = c('#7164E5','#535A76','black'))

        df <- data.frame(t,yi_est,yhat.1)

        print(ggplot(df, aes(t, yi, color=Variable))+
                ylab("Valores")+
                xlab("Tiempo")+
                geom_line(aes(t, yhat.1, col="Valores Ajustados con Estacionalidad Trig."))+
                geom_line(aes(t, yi, col="Valores Iniciales"))+
                ggtitle('Regresion Lineal Simple')+
                theme(plot.title = element_text(hjust = 0.5))+
                theme(legend.position="bottom"))
      }

      # Print Regresión Cúbica
      if(tipo_mod == 3 && tipo_est == 1){
        mod.1 <- lm(yi~t + t2 + t3)
        yhat.1 <- fitted(mod.1)

        #plot.ts(t,yi,lwd=3,col='#7164E5',type='o',main='Regresion Cúbica')
        #lines(t,yhat.1,col='#535A76',lwd=3)
        #legend("bottomright",c('Original','Regresión Cúbica'), lwd=c(3,3,3),col = c('#7164E5','#535A76','black'))

        df <- data.frame(t,yi,yhat.1)

        print(ggplot(df, aes(t, yi, color=Variable))+
                ylab("Valores")+
                xlab("Tiempo")+
                geom_line(aes(t, yi, col="Valores Iniciales"))+
                geom_line(aes(t, yhat.1, col="Valores Ajustados"))+
                ggtitle('Regresion Cuadratica')+
                theme(plot.title = element_text(hjust = 0.5))+
                theme(legend.position="bottom"))
      }

      if(tipo_mod == 3 && tipo_est == 2){
        mod.1 <- lm(yi~ti + ti2 + ti3 + It)
        yhat.1 <- mod.1$fitted.values

        #plot(ti,yi_est,lwd=3,col='#7164E5',type='o',main='Regresion Cubica con Estacionalidad')
        #lines(ti,yhat.1,col='#535A76',lwd=3)
        #legend("bottomright",c('Original','Regresión Cubica con Estacionalidad'), lwd=c(3,3,3),col = c('#7164E5','#535A76','black'))

        df <- data.frame(t,yi_est,yhat.1)

        print(ggplot(df, aes(t, yi, color=Variable))+
                ylab("Valores")+
                xlab("Tiempo")+
                geom_line(aes(t, yi, col="Valores Iniciales"))+
                geom_line(aes(t, yhat.1, col="Valores Ajustados con Estacionalidad Ind."))+
                ggtitle('Regresion Lineal Simple')+
                theme(plot.title = element_text(hjust = 0.5))+
                theme(legend.position="bottom"))
      }

      if(tipo_mod == 3 && tipo_est == 3){
        mod.1 <- lm(yi~ti + ti2 + ti3 + It.trig)
        yhat.1 <- mod.1$fitted.values

        plot(ti,yi_est,lwd=3,col='#7164E5',type='o',main='Regresion Cubica con Estacionalidad')
        lines(ti,yhat.1,col='#535A76',lwd=3)
        legend("bottomright",c('Original','Regresión Cubica con Estacionalidad'), lwd=c(3,3,3),col = c('#7164E5','#535A76','black'))

        df <- data.frame(ti,yi_est,yhat.1)

        print(ggplot(df, aes(ti, yi_est, color=Variable))+
                ylab("Valores")+
                xlab("Tiempo")+
                geom_line(aes(ti, yi_est, col="Valores Iniciales"))+
                geom_line(aes(ti, yhat.1, col="Valores Ajustados con Estacionalidad Trig."))+
                ggtitle('Regresion Lineal Simple')+
                theme(plot.title = element_text(hjust = 0.5))+
                theme(legend.position="bottom"))
      }

      # Print Regresion Holt-Winters
      if(tipo_mod == 4){
        mod.1 <- HoltWinters(yi_est, seasonal = "additive")
        yhat.1 <- fitted(mod.1)[,1]

#        df <- data.frame(ti,yi_est,yhat.1)

        #print(ggplot(df, aes(ti, yi_est, color=Variable))+
        #        ylab("Valores")+
        #        xlab("Tiempo")+
        #        geom_line(aes(ti, yi_est, col="Valores Iniciales"))+
        #        #geom_line(aes(t, yhat.1, col="Valores Ajustados con Holt-Winters"))+
        #        ggtitle('Regresion Lineal Simple')+
        #        theme(plot.title = element_text(hjust = 0.5))+
        #        theme(legend.position="bottom"))

        plot(ti,yi_est,lwd=1,col='#7164E5',type='l', main='Regresion Holt-Winters'
             ,panel.first = grid()
             ,xlab="Tiempo", ylab="Valores")
        lines(ti,c(y[1:4], yhat.1),col='red',lwd=1)
        legend("bottomright",c('Original','Regresión Holt-Winters'), lwd=c(3,3,3),col = c('#7164E5','red','black'))
      }

    })

    # Print Residuos Modelo Regresion
    output$plot_reg_mod1_res <- renderPlot({

      data <-load_data()

      tipo_mod <- as.numeric(input$var_mod_1)
      tipo_est <- as.numeric(input$var_est_1)
      tipo_pro <- as.numeric(input$var_pro_1)

      # Creo la serie de tiempo
      y <- ts(data,start=1,frequency=4)

      # Se dejan los ultimos "n" periodos para validación cruzada
      m <- tipo_pro
      T <- length(y)
      yi <- y[1:(T-m)]
      yf <- y[(T-m+1):T]

      # lineal
      t <- seq(1:(T-m))
      # Cuadratico
      t2 <- t*t
      # Cubico
      t3 <- t*t*t
      # Log
      lyi <- log(yi)

      # estimacion modelos
      yest <- mat.or.vec(length(yi),2)

      # variables modelo con estacionalidad
      yi_est = ts(y[1:(T-m)],frequency=4)
      yf_est = ts(y[(T-m+1):T],frequency=4)

      ti = seq(1,length(yi_est))
      ti2 = ti*ti
      ti3 = ti*ti*ti
      It = seasonaldummy(yi_est)
      It.trig = fourier(yi_est,1)


      if(tipo_mod == 1 && tipo_est == 1){
        mod.1 <- lm(yi~t)
        r = mod.1$residuals

        par(mfrow=c(2,2))
        #Residuo
        plot(t,r,type='o',ylab='Residuo', xlab="t", main="Residuos",
             col=35)
        abline(h=0,lty=2)

        #Density
        plot(density(r),xlab='t',main= 'Densidad')
        polygon(density(r), col="red", border="blue")
        #Q-plot
        qqnorm(r, main="Q-Q Grafico", xlab="Valores teoricos",
               ylab="Valores prueba",col=84)
        qqline(r,col=2)
        #ACF
        acf(r,ci.type="ma",60, main="ACF", col=35)
      }

      if(tipo_mod == 1 && tipo_est == 2){
        mod.1 <- lm(yi~ti + It)
        r = mod.1$residuals

        par(mfrow=c(2,2))
        #Residuo
        plot(ti,r,type='o',ylab='Residuo', xlab="t", main="Residuos",
             col=35)
        abline(h=0,lty=2)

        #Density
        plot(density(r),xlab='t',main= 'Densidad')
        polygon(density(r), col="red", border="blue")
        #Q-plot
        qqnorm(r, main="Q-Q Grafico", xlab="Valores teoricos",
               ylab="Valores prueba",col=84)
        qqline(r,col=2)
        #ACF
        acf(r,ci.type="ma",60, main="ACF", col=35)
      }

      if(tipo_mod == 1 && tipo_est == 3){
        mod.1 <- lm(yi~ti + It.trig)
        r = mod.1$residuals

        par(mfrow=c(2,2))
        #Residuo
        plot(ti,r,type='o',ylab='Residuo', xlab="t", main="Residuos",
             col=35)
        abline(h=0,lty=2)

        #Density
        plot(density(r),xlab='t',main= 'Densidad')
        polygon(density(r), col="red", border="blue")
        #Q-plot
        qqnorm(r, main="Q-Q Grafico", xlab="Valores teoricos",
               ylab="Valores prueba",col=84)
        qqline(r,col=2)
        #ACF
        acf(r,ci.type="ma",60, main="ACF", col=35)
      }

      # Print Regresión Cuadrática
      if(tipo_mod == 2 && tipo_est == 1){
        mod.1 <- lm(yi~t + t2)
        r = mod.1$residuals

        par(mfrow=c(2,2))
        #Residuo
        plot(t,r,type='o',ylab='Residuo', xlab="t", main="Residuos",
             col=35)
        abline(h=0,lty=2)
        #Density
        plot(density(r),xlab='t',main= 'Densidad')
        polygon(density(r), col="red", border="blue")
        #Q-plot
        qqnorm(r, main="Q-Q Grafico", xlab="Valores teoricos",
               ylab="Valores prueba",col=84)
        qqline(r,col=2)
        #ACF
        acf(r,ci.type="ma",60, main="ACF", col=35)
      }

      if(tipo_mod == 2 && tipo_est == 2){
        mod.1 <- lm(yi~ti + ti2 + It)
        r = mod.1$residuals

        par(mfrow=c(2,2))
        #Residuo
        plot(ti,r,type='o',ylab='Residuo', xlab="t", main="Residuos",
             col=35)
        abline(h=0,lty=2)
        #Density
        plot(density(r),xlab='t',main= 'Densidad')
        polygon(density(r), col="red", border="blue")
        #Q-plot
        qqnorm(r, main="Q-Q Grafico", xlab="Valores teoricos",
               ylab="Valores prueba",col=84)
        qqline(r,col=2)
        #ACF
        acf(r,ci.type="ma",60, main="ACF", col=35)
      }

      if(tipo_mod == 2 && tipo_est == 3){
        mod.1 <- lm(yi~ti + ti2 + It.trig)
        r = mod.1$residuals

        par(mfrow=c(2,2))
        #Residuo
        plot(ti,r,type='o',ylab='Residuo', xlab="t", main="Residuos",
             col=35)
        abline(h=0,lty=2)
        #Density
        plot(density(r),xlab='t',main= 'Densidad')
        polygon(density(r), col="red", border="blue")
        #Q-plot
        qqnorm(r, main="Q-Q Grafico", xlab="Valores teoricos",
               ylab="Valores prueba",col=84)
        qqline(r,col=2)
        #ACF
        acf(r,ci.type="ma",60, main="ACF", col=35)
      }


      # Print Regresión Cúbica
      if(tipo_mod == 3 && tipo_est == 1){
        mod.1 <- lm(yi~t + t2 + t3)
        r = mod.1$residuals

        par(mfrow=c(2,2))
        #Residuo
        plot(t,r,type='o',ylab='Residuo', xlab="t", main="Residuos",
             col=35)
        abline(h=0,lty=2)
        #Density
        plot(density(r),xlab='t',main= 'Densidad')
        polygon(density(r), col="red", border="blue")
        #Q-plot
        qqnorm(r, main="Q-Q Grafico", xlab="Valores teoricos",
               ylab="Valores prueba",col=84)
        qqline(r,col=2)
        #ACF
        acf(r,ci.type="ma",60, main="ACF", col=35)
      }

      if(tipo_mod == 3 && tipo_est == 2){
        mod.1 <- lm(yi~t + t2 + t3 + It)
        r = mod.1$residuals

        par(mfrow=c(2,2))
        #Residuo
        plot(ti,r,type='o',ylab='Residuo', xlab="t", main="Residuos",
             col=35)
        abline(h=0,lty=2)
        #Density
        plot(density(r),xlab='t',main= 'Densidad')
        polygon(density(r), col="red", border="blue")
        #Q-plot
        qqnorm(r, main="Q-Q Grafico", xlab="Valores teoricos",
               ylab="Valores prueba",col=84)
        qqline(r,col=2)
        #ACF
        acf(r,ci.type="ma",60, main="ACF", col=35)
      }

      if(tipo_mod == 3 && tipo_est == 3){
        mod.1 <- lm(yi~ti + ti2 + ti3 + It.trig)
        r = mod.1$residuals

        par(mfrow=c(2,2))
        #Residuo
        plot(ti,r,type='o',ylab='Residuo', xlab="t", main="Residuos",
             col=35)
        abline(h=0,lty=2)
        #Density
        plot(density(r),xlab='t',main= 'Densidad')
        polygon(density(r), col="red", border="blue")
        #Q-plot
        qqnorm(r, main="Q-Q Grafico", xlab="Valores teoricos",
               ylab="Valores prueba",col=84)
        qqline(r,col=2)
        #ACF
        acf(r,ci.type="ma",60, main="ACF", col=35)
      }

      # Print Residuos Holt-Winters
      if(tipo_mod == 4){
        #mod.1 <- lm(yi~ti + ti2 + It.trig)
        mod.1 <- HoltWinters(yi_est, seasonal = "additive")
        r = residuals(mod.1)

        par(mfrow=c(2,2))
        #Residuo
        #plot(ti,r,type='o',ylab='Residuo', xlab="t", main="Residuos",
        #     col=35)
        abline(h=0,lty=2)
        #Density
        plot(density(r),xlab='t',main= 'Densidad')
        polygon(density(r), col="red", border="blue")
        #Q-plot
        qqnorm(r, main="Q-Q Grafico", xlab="Valores teoricos",
               ylab="Valores prueba",col=84)
        qqline(r,col=2)
        #ACF
        acf(r,ci.type="ma",60, main="ACF", col=35)
      }
    })

    # Print Resultados Modelo Regresion
    output$resumen_mod1 <- renderPrint({

      source("medidas.r")

      data <-load_data()

      tipo_mod <- as.numeric(input$var_mod_1)
      tipo_est <- as.numeric(input$var_est_1)
      tipo_pro <- as.numeric(input$var_pro_1)
      y <- ts(data,start=1,frequency=4)

      # Se dejan los ultimos "n" periodos para validación cruzada
      m <- tipo_pro
      T <- length(y)
      yi <- y[1:(T-m)]
      yf <- y[(T-m+1):T]

      # lineal
      t <- seq(1:(T-m))
      # Cuadratico
      t2 <- t*t
      # Cubico
      t3 <- t*t*t
      # Log
      lyi <- log(yi)

      # estimacion modelos
      yest <- mat.or.vec(length(yi),2)

      # variables modelo con estacionalidad
      yi_est = ts(y[1:(T-m)],frequency=4)
      yf_est = ts(y[(T-m+1):T],frequency=4)

      ti = seq(1,length(yi_est))
      ti2 = ti*ti
      ti3 = ti*ti*ti
      It = seasonaldummy(yi_est)
      It.trig = fourier(yi_est,1)


      if(tipo_mod == 1 && tipo_est == 1){
        mod.1 <- lm(yi~t)
        medidas(mod.1,yi,3)
        summary(mod.1)
      }

      else if(tipo_mod == 1 && tipo_est == 2){
        mod.1 <- lm(yi~ti + It)
        medidas(mod.1,yi_est,3)
        summary(mod.1)
      }

      else if(tipo_mod == 1 && tipo_est == 3){
        mod.1 <- lm(yi~ti + It.trig)
        medidas(mod.1,yi_est,3)
        summary(mod.1)
      }

      # Print Regresión Cuadrática
      else if(tipo_mod == 2 && tipo_est == 1){
        mod.1 <- lm(yi~t + t2)
        medidas(mod.1,yi,3)
        summary(mod.1)
      }

      else if(tipo_mod == 2 && tipo_est == 2){
        mod.1 <- lm(yi~ti + ti2 + It)
        medidas(mod.1,yi_est,3)
        summary(mod.1)
      }

      else if(tipo_mod == 2 && tipo_est == 3){
        mod.1 <- lm(yi~ti + ti2 + It.trig)
        medidas(mod.1,yi_est,3)
        summary(mod.1)
      }

      # Print Regresión Cúbica
      else if(tipo_mod == 3 && tipo_est == 1){
        mod.1 <- lm(yi~t + t2 + t3)
        medidas(mod.1,yi,3)
        summary(mod.1)
      }

      else if(tipo_mod == 3 && tipo_est == 2){
        mod.1 <- lm(yi~t + t2 + t3 + It)
        medidas(mod.1,yi_est,3)
        summary(mod.1)
      }

      else if(tipo_mod == 3 && tipo_est == 3){
        mod.1 <- lm(yi~ti + ti2 + ti3 + It.trig)
        medidas(mod.1,yi_est,3)
        summary(mod.1)
      }

      else if(tipo_mod == 4){
        mod.1 <- HoltWinters(yi_est, seasonal = "additive")
        yhat.1 <- fitted(mod.1)[,1]
        #summary(mod.1)
        medidas.hw(mod.1,yi_est,3)
      }


    })

    # Print Pronosticos
    output$plot_pro_mod1 <- renderPlot({

      data <-load_data()

      tipo_mod <- as.numeric(input$var_mod_11)
      tipo_est <- as.numeric(input$var_est_11)
      tipo_pro <- as.numeric(input$var_pro_11)

      anyo <- as.numeric(input$var_anyo)
      mes <- as.numeric(input$var_mes)
      tipo_fq <- as.numeric(input$var_fre_1)
      fq = 4

      # Frecuencia
      # Mensual
      if(tipo_fq == 1)
        fq = 12
      # Trimestral
      if(tipo_fq == 2)
        fq = 4

      # Creo la serie de tiempo
      y <- ts(data,start=c(anyo,mes),frequency=fq)

      # Se dejan los ultimos "n" periodos para validación cruzada
      m <- tipo_pro
      T <- length(y)
      yi <- y[1:(T-m)]
      yf <- y[(T-m+1):T]

      # lineal
      t <- seq(1:(T-m))
      # Cuadratico
      t2 <- t*t
      # Cubico
      t3 <- t*t*t
      # Log
      lyi <- log(yi)

      # variables modelo con estacionalidad
      yi_est = ts(y[1:(T-m)],frequency=fq)
      yf_est = ts(y[(T-m+1):T],frequency=fq)

      #t_pro = T-m

      t_pro = m

      ti = seq(1,length(yi_est))
      ti2 = ti*ti
      ti3 = ti*ti*ti

      It = seasonaldummy(yi_est)
      It.trig = fourierf(yi_est,2,t_pro)

      # variables de los pronosticos
      yf = ts(y[(T-m+1):T],frequency=fq)

      Itf = seasonaldummy(yi_est,t_pro)
      Itf.Trig = fourierf(yi_est,2,t_pro)

      # Tiempo
      tt = seq(T+1,T+m,1)
      t_r <- seq(1:T)

      tf = seq(T+1,T+t_pro,1)
      tf2 = tf * tf
      tf3 = tf2 * tf

      if(tipo_mod == 1 && tipo_est == 1){
        mod.1 <- lm(yi~t)
        yhat.1 <- fitted(mod.1)
        pro.1 = predict(mod.1,data.frame(t = tf), interval = "prediction")

        #plot(t_r,y,lwd=3,col='#7164E5',type='o',main='Pronostico',xlim = c(min(t_r),max(tf)),ylim = c(min(y),max(pro.1[,1])))
        #lines(ti,yhat.1, type = 'b',col='green')
        #lines(tf,pro.1[,1], type = 'b',col='green')
        #legend("bottomright",c('Original','Regresión Lineal Simple'), lwd=c(3,3,3),col = c('#7164E5','#535A76','black'))

        # aqui sirve
        plot(tt,yf,col='#7164E5',type='o',main='Pronostico con Reg. Lineal',xlim = c(min(tt,tf),max(tt,tf)),ylim = c(min(yf,pro.1[,1]),max(yf,pro.1[,1]))
             ,panel.first = grid()
             ,xlab="Tiempo", ylab="Valores")
        lines(tf,pro.1[,1], type = 'b',col='green')
        legend("bottomright",c('Original','Pronostico'), lwd=c(3,3,3),col = c('#7164E5','green','black'))

      }

      if(tipo_mod == 1 && tipo_est == 2){
        mod.1 <- lm(yi_est~ti + It)
        yhat.1 <- fitted(mod.1)
        pro.1 = predict(mod.1,data.frame(ti = tf , It = I(Itf)), interval = "prediction")

        plot(tt,yf,col='#7164E5',type='o',main='Pronosticos con Reg. Lineal y Estacionalidad',xlim = c(min(tt,tf),max(tt,tf)),ylim = c(min(yf,pro.1[,1]),max(yf,pro.1[,1]))
             ,panel.first = grid()
             ,xlab="Tiempo", ylab="Valores")
        #plot(t_r,y,lwd=3,col='#7164E5',type='o',main='Pronostico',xlim = c(0,30),ylim = c(0,5000))
        lines(tf,pro.1[,1], type = 'b',col='green')
        legend("bottomright",c('Original','Pronostico'), lwd=c(3,3,3),col = c('#7164E5','green','black'))
      }

      if(tipo_mod == 1 && tipo_est == 3){
        mod.1 <- lm(yi_est~ti + It.trig)
        yhat.1 <- fitted(mod.1)
        pro.1 = predict(mod.1,data.frame(ti = tf , It.trig = I(Itf.Trig)), interval = "prediction")

        plot(tt,yf,col='#7164E5',type='o',main='Pronostico con Reg. Lineal y Estacionalidad',xlim = c(min(tt,tf),max(tt,tf)),ylim = c(min(yf,pro.1[,1]),max(yf,pro.1[,1]))
             ,panel.first = grid()
             ,xlab="Tiempo", ylab="Valores")
        lines(tf,pro.1[,1], type = 'b',col='green')
        legend("bottomright",c('Original','Pronostico'), lwd=c(3,3,3),col = c('#7164E5','green','black'))
      }

      # Print Regresión Cuadrática
      if(tipo_mod == 2 && tipo_est == 1){
        mod.1 <- lm(yi~t + t2)
        yhat.1 <- fitted(mod.1)
        pro.1 = predict(mod.1,data.frame(t = tf, t2 = tf2), interval = "prediction")

        #plot(tt,yf,lwd=3,col='#7164E5',type='o',main='Pronostico',xlim = c(min(tt,tf),max(tt,tf)),ylim = c(min(yf,pro.1[,1]),max(yf,pro.1[,1])))
        #lines(tf,pro.1[,1], type = 'b',col='green')
        #legend("bottomright",c('Original','Regresión Lineal Simple'), lwd=c(3,3,3),col = c('#7164E5','#535A76','black'))

        plot(tt,yf,col='#7164E5',type='o',main='Pronostico con Reg. Cuadrática',xlim = c(min(tt,tf),max(tt,tf)),ylim = c(min(yf,pro.1[,1]),max(yf,pro.1[,1]))
             ,panel.first = grid()
             ,xlab="Tiempo", ylab="Valores")
        lines(tf,pro.1[,1], type = 'b',col='green')
        legend("bottomright",c('Original','Pronostico'), lwd=c(3,3,3),col = c('#7164E5','green','black'))

      }

      if(tipo_mod == 2 && tipo_est == 2){
        mod.1 <- lm(yi_est~ti + ti2 + It)
        yhat.1 <- fitted(mod.1)
        pro.1 = predict(mod.1,data.frame(ti = tf , ti2 = tf2 , It = I(Itf)), interval = "prediction")

        #plot(tt,yf,lwd=3,col='#7164E5',type='o',main='Pronostico',xlim = c(min(tt,tf),max(tt,tf)),ylim = c(min(yf,pro.1[,1]),max(yf,pro.1[,1])))
        #lines(tf,pro.1[,1], type = 'b',col='red')
        #legend("bottomright",c('Original','Regresión Lineal Simple'), lwd=c(3,3,3),col = c('#7164E5','#535A76','black'))

        plot(tt,yf,col='#7164E5',type='o',main='Pronostico con Reg. Cuadrática y Estacionalidad',xlim = c(min(tt,tf),max(tt,tf)),ylim = c(min(yf,pro.1[,1]),max(yf,pro.1[,1]))
             ,panel.first = grid()
             ,xlab="Tiempo", ylab="Valores")
        lines(tf,pro.1[,1], type = 'b',col='green')
        legend("bottomright",c('Original','Pronostico'), lwd=c(3,3,3),col = c('#7164E5','green','black'))

      }

      if(tipo_mod == 2 && tipo_est == 3){
        mod.1 <- lm(yi_est~ti + ti2 + It.trig)
        yhat.1 <- fitted(mod.1)
        pro.1 = predict(mod.1,data.frame(ti = tf , ti2 = tf2, It.trig = I(Itf.Trig)), interval = "prediction")

        #plot(tt,yf,lwd=3,col='#7164E5',type='o',main='Pronostico',xlim = c(min(tt,tf),max(tt,tf)),ylim = c(min(yf,pro.1[,1]),max(yf,pro.1[,1])))
        #lines(tf,pro.1[,1], type = 'b',col='green')
        #legend("bottomright",c('Original','Regresión Lineal Simple'), lwd=c(3,3,3),col = c('#7164E5','#535A76','black'))

        plot(tt,yf,col='#7164E5',type='o',main='Pronostico con Reg. Cuadrática y Estacionalidad',xlim = c(min(tt,tf),max(tt,tf)),ylim = c(min(yf,pro.1[,1]),max(yf,pro.1[,1]))
             ,panel.first = grid()
             ,xlab="Tiempo", ylab="Valores")
        lines(tf,pro.1[,1], type = 'b',col='green')
        legend("bottomright",c('Original','Pronostico'), lwd=c(3,3,3),col = c('#7164E5','green','black'))

      }

      # Print Regresión Cubica
      if(tipo_mod == 3 && tipo_est == 1){
        mod.1 <- lm(yi~t + t2 + t3)
        yhat.1 <- fitted(mod.1)
        pro.1 = predict(mod.1,data.frame(t = tf, t2 = tf2, t3 = tf3), interval = "prediction")

        #plot(tt,yf,lwd=3,col='#7164E5',type='o',main='Pronostico',xlim = c(min(tt,tf),max(tt,tf)),ylim = c(min(yf,pro.1[,1]),max(yf,pro.1[,1])))
        #lines(tf,pro.1[,1], type = 'b',col='green')
        #legend("bottomright",c('Original','Regresión Lineal Simple'), lwd=c(3,3,3),col = c('#7164E5','#535A76','black'))

        plot(tt,yf,col='#7164E5',type='o',main='Pronostico con Reg. Cúbica',xlim = c(min(tt,tf),max(tt,tf)),ylim = c(min(yf,pro.1[,1]),max(yf,pro.1[,1]))
             ,panel.first = grid()
             ,xlab="Tiempo", ylab="Valores")
        lines(tf,pro.1[,1], type = 'b',col='green')
        legend("bottomright",c('Original','Pronostico'), lwd=c(3,3,3),col = c('#7164E5','green','black'))

      }


      if(tipo_mod == 3 && tipo_est == 2){
        mod.1 <- lm(yi_est~ti + ti2 + ti3 + It)
        yhat.1 <- fitted(mod.1)
        pro.1 = predict(mod.1,data.frame(ti = tf, ti2 = tf2, ti3 = tf3, It = I(Itf)), interval = "prediction")

        #plot(tt,yf,lwd=3,col='#7164E5',type='o',main='Pronostico',xlim = c(min(tt,tf),max(tt,tf)),ylim = c(min(yf,pro.1[,1]),max(yf,pro.1[,1])))
        #lines(tf,pro.1[,1], type = 'b',col='green')
        #legend("bottomright",c('Original','Regresión Lineal Simple'), lwd=c(3,3,3),col = c('#7164E5','#535A76','black'))

        plot(tt,yf,col='#7164E5',type='o',main='Pronostico con Reg. Cúbica y Estacionalidad',xlim = c(min(tt,tf),max(tt,tf)),ylim = c(min(yf,pro.1[,1]),max(yf,pro.1[,1]))
             ,panel.first = grid()
             ,xlab="Tiempo", ylab="Valores")
        lines(tf,pro.1[,1], type = 'b',col='green')
        legend("bottomright",c('Original','Pronostico'), lwd=c(3,3,3),col = c('#7164E5','green','black'))
      }

      # Print Holt-Winters
      if(tipo_mod == 4){
        mod.1 <- HoltWinters(yi_est, seasonal = "additive")
        yhat.1 <- fitted(mod.1)[,1]

        pro.1 = predict(mod.1, m, prediction.interval = TRUE)

        #plot(tt,yf,lwd=3,col='#7164E5',type='o',main='Pronostico')
        #lines(tf,pro.1[,1], type = 'b',col='green')
        #legend("bottomright",c('Original','Regresión Lineal Simple'), lwd=c(3,3,3),col = c('#7164E5','#535A76','black'))

        plot(tt,yf,col='#7164E5',type='o',main='Pronostico con Holt-Winters',xlim = c(min(tt,tf),max(tt,tf)),ylim = c(min(yf,pro.1[,1]),max(yf,pro.1[,1]))
             ,panel.first = grid()
             ,xlab="Tiempo", ylab="Valores")
        lines(tf,pro.1[,1], type = 'b',col='green')
        legend("bottomright",c('Original','Pronostico'), lwd=c(3,3,3),col = c('#7164E5','green','black'))

      }
    })
  }
)
reos156/AnalisisSeriesTiempo documentation built on May 31, 2019, 8:56 a.m.