# 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'))
}
})
}
)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.