├── Forcast ├── RSM.png ├── rsconnect │ └── shinyapps.io │ │ └── jasonliushiny │ │ └── Forcast.dcf ├── FileUpLoad.R ├── .Rhistory ├── ui.R └── server.R ├── README └── .gitattributes /Forcast/RSM.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/liujiashen9307/Forcast/HEAD/Forcast/RSM.png -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | Time series forecasting tutorial app. Link can be found at : https://jasonliushiny.shinyapps.io/Forcast/ 2 | -------------------------------------------------------------------------------- /Forcast/rsconnect/shinyapps.io/jasonliushiny/Forcast.dcf: -------------------------------------------------------------------------------- 1 | name: Forcast 2 | account: jasonliushiny 3 | server: shinyapps.io 4 | appId: 104117 5 | bundleId: 462791 6 | url: https://jasonliushiny.shinyapps.io/Forcast/ 7 | when: 1464208810.5868 8 | -------------------------------------------------------------------------------- /Forcast/FileUpLoad.R: -------------------------------------------------------------------------------- 1 | library(rsconnect) 2 | rsconnect::setAccountInfo(name='jasonliushiny', token='7126F3F8DDD386145AC48A82E3A94751', secret='qhQqWmVRDOTuBK+key/oob72TcLFg3xLANZNTDDr') 3 | rsconnect::deployApp('C:/Users/apple/Desktop/R Practice/Practice Shinny/Forcast') 4 | 5 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | * text=auto 3 | 4 | # Custom for Visual Studio 5 | *.cs diff=csharp 6 | 7 | # Standard to msysgit 8 | *.doc diff=astextplain 9 | *.DOC diff=astextplain 10 | *.docx diff=astextplain 11 | *.DOCX diff=astextplain 12 | *.dot diff=astextplain 13 | *.DOT diff=astextplain 14 | *.pdf diff=astextplain 15 | *.PDF diff=astextplain 16 | *.rtf diff=astextplain 17 | *.RTF diff=astextplain 18 | -------------------------------------------------------------------------------- /Forcast/.Rhistory: -------------------------------------------------------------------------------- 1 | library(rsconnect) 2 | rsconnect::setAccountInfo(name='jasonliushiny', token='7126F3F8DDD386145AC48A82E3A94751', secret='qhQqWmVRDOTuBK+key/oob72TcLFg3xLANZNTDDr') 3 | rsconnect::deployApp('C:/Users/apple/Desktop/R Practice/Practice Shinny/Forcast') 4 | shiny::runApp() 5 | library(rsconnect) 6 | rsconnect::setAccountInfo(name='jasonliushiny', token='7126F3F8DDD386145AC48A82E3A94751', secret='qhQqWmVRDOTuBK+key/oob72TcLFg3xLANZNTDDr') 7 | rsconnect::deployApp('C:/Users/apple/Desktop/R Practice/Practice Shinny/Forcast') 8 | library(rsconnect) 9 | rsconnect::setAccountInfo(name='jasonliushiny', token='7126F3F8DDD386145AC48A82E3A94751', secret='qhQqWmVRDOTuBK+key/oob72TcLFg3xLANZNTDDr') 10 | rsconnect::deployApp('C:/Users/apple/Desktop/R Practice/Practice Shinny/Forcast') 11 | library(rsconnect) 12 | rsconnect::setAccountInfo(name='jasonliushiny', token='7126F3F8DDD386145AC48A82E3A94751', secret='qhQqWmVRDOTuBK+key/oob72TcLFg3xLANZNTDDr') 13 | rsconnect::deployApp('C:/Users/apple/Desktop/R Practice/Practice Shinny/Forcast') 14 | shiny::runApp() 15 | shiny::runApp() 16 | shiny::runApp() 17 | library(plotly) 18 | library(sqldf) 19 | library(shiny) 20 | -------------------------------------------------------------------------------- /Forcast/ui.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(shinythemes) 3 | shinyUI(navbarPage( 4 | theme = shinytheme("superhero"), 5 | strong("Time Series Forecasting Tutorial App"), 6 | tabPanel("Data Summary", 7 | sidebarLayout( 8 | sidebarPanel( 9 | radioButtons("RD1",label=h3(strong("Data Type")),choices = list("Demo"=1,"Your Data"=2),selected = 1), 10 | 11 | conditionalPanel(condition="input.RD1==2",fileInput('file1', h4(strong('Choose csv File')), 12 | accept=c('text/csv', 13 | 'text/comma-separated-values,text/plain', 14 | '.csv')), 15 | checkboxInput('header', 'Header', TRUE), 16 | radioButtons('sep', 'Separator', 17 | c(Comma=',', 18 | Semicolon=';', 19 | Tab='\t'), 20 | ','), 21 | radioButtons('quote', 'Quote', 22 | c(None='', 23 | 'Double Quote'='"', 24 | 'Single Quote'="'"), 25 | '"')) 26 | , 27 | numericInput("Col",strong("Column to Analysis"),value = 2) 28 | 29 | , 30 | 31 | h4(strong("Time Series Setting")), 32 | numericInput("Start",strong("Start Period"),value = 1949), 33 | 34 | numericInput("freq",strong("Frequency"),value=12), 35 | h4(strong("Holdout Sample Setting")), 36 | numericInput("Starth",strong("Start Period"),value = 1960), 37 | numericInput("Endh",strong("End Period"),value = 1961) 38 | ), 39 | 40 | 41 | mainPanel(fluidRow( 42 | 43 | column(10,h3("Summary"),verbatimTextOutput("summary")), 44 | column(10,h3("Table"),dataTableOutput("table")), 45 | column(10,h3("Plot"),plotOutput("PlotG")) 46 | 47 | ) 48 | 49 | ) 50 | 51 | )), 52 | 53 | tabPanel("Naive Method", 54 | sidebarLayout( 55 | sidebarPanel( 56 | 57 | 'Naive Method Does not Need any Parameter.' 58 | ), 59 | 60 | mainPanel( 61 | fluidRow( 62 | h3('Model Introduction'), 63 | p('Naive forecasts are the most cost effective forecasting model. Generally, it just use the value of past to predict the near future',align='justify'), 64 | 65 | column(10,h4(strong('Forecasting Plot')),plotOutput("Plot0")), 66 | 67 | column(10,h4(strong('Accuracy Table')),tableOutput("accu0")), 68 | 69 | column(10,h4(strong('Accuracy Bar Plot')),plotOutput("Plot00")) 70 | ) 71 | ) 72 | )) 73 | , 74 | navbarMenu("Smoothing Method", 75 | tabPanel("Simple Exponential Smoothing", 76 | sidebarLayout( 77 | sidebarPanel( 78 | 79 | sliderInput("CI",label="Confience Interval",min=0.01,max=0.99,value=0.9) 80 | , 81 | radioButtons("F2",h4(strong("Determinant or Optimal")),choices = list("Optimal"=1,"Determinant"=2),selected = 1) 82 | , 83 | conditionalPanel(condition="input.F2==2",sliderInput("AlphaS","Your Alpha Value",min=0,max=1,value=0.2)) 84 | ), 85 | mainPanel( 86 | fluidRow( 87 | h3('Model Introduction'), 88 | p('Simple exponential smoothing. The simplest of the exponentially smoothing methods is naturally called simple exponential smoothing (SES). (In some books, it is called single exponential smoothing.) This method is suitable for forecasting data with no trend or seasonal pattern.',align='justify'), 89 | 90 | column(10,h4(strong('Forecasting Plot')),plotOutput("Plot1")), 91 | 92 | column(10,h4(strong('Accuracy Table')),tableOutput("accu1")), 93 | column(10,h4(strong('Accuracy Bar Plot')),plotOutput("Plot2")) 94 | ) 95 | ) 96 | )), 97 | tabPanel("Linear Exponential Smoothing", 98 | sidebarLayout( 99 | (sidebarPanel( 100 | 101 | 102 | sliderInput("CI1",label="Confience Interval",min=0.01,max=0.99,value=0.9) 103 | , 104 | radioButtons("F4",h4(strong("Determinant or Optimal")),choices = list("Optimal"=1,"Determinant"=2),selected = 1) 105 | , 106 | conditionalPanel(condition="input.F4==2",sliderInput("AlphaL","Your Alpha Value",min=0,max=1,value=0.2),sliderInput("BetaL","Your Beta Value",min = 0,max = 1,value = 0.2)) 107 | ) 108 | ), 109 | mainPanel( 110 | fluidRow( 111 | h3('Model Introduction'), 112 | p('Holt (1957) extended simple exponential smoothing to allow forecasting of data with a trend. This method involves a forecast equation and two smoothing equations (one for the level and one for the trend)',align='justify'), 113 | 114 | column(10,h4(strong('Forecasting Plot')),plotOutput("Plot3")), 115 | 116 | column(10,h4(strong('Accuracy Table')),tableOutput("accu2")), 117 | column(10,h4(strong('Accuracy Bar Plot')),plotOutput("Plot4")) 118 | ) 119 | ) 120 | )), 121 | tabPanel("Holt Winter Method", 122 | sidebarLayout( 123 | sidebarPanel( 124 | 125 | sliderInput("CI2",label="Confience Interval",min=0.01,max=0.99,value=0.9) 126 | , 127 | radioButtons("F6",h4(strong("Determinant or Optimal")),choices = list("Optimal"=1,"Determinant"=2),selected = 1), 128 | radioButtons("AM",h4(strong("Additive or Multiplicative")),choices=list("Additive"=1,"Multiplicative"=2),selected=1) 129 | , 130 | conditionalPanel(condition="input.F6==2",sliderInput("AlphaH","Your Alpha Value",min=0,max=1,value=0.2),sliderInput("BetaH","Your Beta Value",min = 0,max = 1,value = 0.2),sliderInput("GammaH","Your Gamma Value",min=0,max=1,value=0.2)) 131 | 132 | 133 | ), 134 | mainPanel( 135 | fluidRow( 136 | h3('Model Introduction'), 137 | p('Holt (1957) and Winters (1960) extended Holt method to capture seasonality. The Holt Winters seasonal method comprises the forecast equation and three smoothing equations, one for the level, one for trend, and one for the seasonal component',align='Justify'), 138 | column(10,h4(strong('Forecasting Plot')),plotOutput("Plot5")), 139 | 140 | column(10,h4(strong('Accuracy Table')),tableOutput("accu3")), 141 | column(10,h4(strong('Accuracy Bar Plot')),plotOutput("Plot6")) 142 | ) 143 | ) 144 | ))), 145 | tabPanel("Regression Method ", 146 | sidebarLayout( 147 | sidebarPanel( 148 | radioButtons("Trans",h4(strong("Data Transformation")),choices = list("Normal"=1,"Logarithm"=2,"Powered"=3),selected = 1), 149 | 150 | sliderInput("CI3","Confidence Interval",min = 0.01,max = 0.99,value = 0.9) 151 | 152 | ), 153 | mainPanel( 154 | fluidRow( 155 | h3('Model Introduction'), 156 | p('In statistical modeling, regression analysis is a statistical process for estimating the relationships among variables. It includes many techniques for modeling and analyzing several variables, when the focus is on the relationship between a dependent variable and one or more independent variables (or predictors).',align='Justify'), 157 | column(10,h4(strong('Forecasting Plot')),plotOutput("Plot7")), 158 | 159 | column(10,h4(strong('Accuracy Table')),tableOutput("accu4")), 160 | column(10,h4(strong('Accuracy Bar Plot')),plotOutput("plot8")) 161 | ) 162 | ) 163 | )), 164 | 165 | tabPanel("Neural Network", 166 | sidebarLayout( 167 | sidebarPanel( 168 | 169 | 170 | sliderInput("CI4",label="Confience Interval",min=0.01,max=0.99,value=0.9) 171 | 172 | ), 173 | 174 | mainPanel( 175 | fluidRow( 176 | h3('Model Introduction'), 177 | p('A neural network usually involves a large number of processors operating in parallel and arranged in tiers. The first tier receives the raw input information -- analogous to optic nerves in human visual processing. Each successive tier receives the output from the tier preceding it, rather than from the raw input -- in the same way neurons further from the optic nerve receive signals from those closer to it. The last tier produces the output of the system.',align='Justify'), 178 | column(10,h4(strong('Forecasting Plot')),plotOutput("Plot9")), 179 | column(10,h4(strong('Accuracy Table')),tableOutput("accu5")), 180 | column(10,h4(strong('Accuracy Bar Plot')),plotOutput("Plot10")) 181 | ) 182 | ) 183 | )), 184 | tabPanel("ARIMA Method", 185 | sidebarLayout( 186 | sidebarPanel( 187 | 188 | 189 | sliderInput("CI5",label="Confience Interval",min=0.01,max=0.99,value=0.9) 190 | 191 | ), 192 | 193 | mainPanel( 194 | fluidRow( 195 | h3('Model Introduction'), 196 | p('In statistics and econometrics, and in particular in time series analysis, an autoregressive integrated moving average (ARIMA) model is a generalization of an autoregressive moving average (ARMA) model. These models are fitted to time series data either to better understand the data or to predict future points in the series (forecasting). They are applied in some cases where data show evidence of non-stationarity, where an initial differencing step (corresponding to the "integrated" part of the model) can be applied to reduce the non-stationarity.',align='Justify'), 197 | 198 | column(10,h4(strong('Forecasting Plot')),plotOutput("Plot11")), 199 | column(10,h4(strong('Accuracy Table')),tableOutput("accu6")), 200 | column(10,h4(strong('Accuracy Bar Plot')),plotOutput("Plot12")) 201 | ) 202 | ) 203 | )), 204 | tabPanel("Read Me", 205 | h3(strong("Introduction")), 206 | br(), 207 | p("This App can be used as a simple tool to test when should a specific smoothing forecasting technique be implemented. Seven models are embeded within App",align="Justify"), 208 | p("The first part presents the summary of data you choose to analyze. The user can either upload his/her own data or use the demo data inside the R package 'fma' (airpass). Then the user should choose the column of data frame that contains the data requiring analysis. The frequency of data and the beginning/ending periods of both fitting sample and hold out sample can be set afterward. ",align="Justify"), 209 | p("Then the user can compare different forecasting techniques by switching to different tab panels. You can creat your own training and testing set in the data summary panel by yourself, and explore the in-sample and out-sample accuracies of the model.",align="Justify"), 210 | 211 | p("In case users want to upload their own data set, the suggested form of data frame is that time in the first column and observation in the second column. However, once the location of observations is consistent with the column input, the app will definitely work. (Do not forget to set the frequency in case you want to test Holt winter model!)",align="Justify"), 212 | br(), 213 | h3(strong("Author")), 214 | p("Author: Jiashen Liu"), 215 | p("Msc. Supply Chain Management Graduate from"), 216 | HTML(''), 217 | p("Email: liujiashen9307@163.com"), 218 | h5("Linkedin"), 219 | a(h5("Jiashen Liu"),href="https://nl.linkedin.com/in/jiashen-liu-4658aa112",target="_blank"), 220 | p(strong('If you are interested in the orginal code of this app, you can find it on my Github page. Link is presented below.')), 221 | a(h5("Code Here"),href="https://github.com/liujiashen9307/Forcast",target="_blank") 222 | ) 223 | 224 | ) 225 | ) 226 | 227 | 228 | 229 | -------------------------------------------------------------------------------- /Forcast/server.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(forecast) 3 | library(fma) 4 | data(airpass, package="fma") 5 | DData<-data.frame(Time=seq(1,144),airpass) 6 | shinyServer(function(input,output,session){ 7 | MyData <- reactive({ 8 | if(input$RD1==2){ 9 | inFile<-input$file1 10 | if (is.null(inFile)) 11 | return(NULL) 12 | read.csv(inFile$datapath, header=input$header, sep=input$sep, 13 | quote=input$quote) 14 | }else{ 15 | DData 16 | } 17 | }) 18 | Col<-reactive({input$Col}) 19 | Start<-reactive({input$Start}) 20 | End<-reactive({input$End}) 21 | Fre<-reactive({input$freq}) 22 | Hstar<-reactive({input$Starth}) 23 | Hend<-reactive({input$Endh}) 24 | output$summary<-renderPrint({ 25 | summary(MyData()[,Col()]) 26 | }) 27 | output$table<-renderDataTable({ 28 | MyData() 29 | }) 30 | output$PlotG<-renderPlot({ 31 | if(is.null(MyData())!=T){ 32 | plot(MyData()[,Col()],ylab="Observations")+lines(MyData()[,Col()]) 33 | } 34 | }) 35 | output$Plot1<-renderPlot({ 36 | TotalTS<-ts(MyData()[,Col()],start=Start(),frequency = Fre()) 37 | InsampleTs<-window(TotalTS,start = c(Start(),1),end=c((Hstar()-1),Fre())) 38 | OutsampleTs<-window(TotalTS,start=c(Hstar(),1),end = c(Hend(),Fre())) 39 | if(input$F2==1){ 40 | forecast1<-ses(InsampleTs,h=length(OutsampleTs),level = input$CI) 41 | plot(forecast1,xlab="Time",ylab="Observations") 42 | lines(forecast1$fit,col="red",lty=2) 43 | lines(OutsampleTs,col="green",lty=2) 44 | } 45 | if(input$F2==2){ 46 | forecast1<-ses(InsampleTs,h=length(OutsampleTs),initial = "simple",level = input$CI,alpha = input$AlphaS) 47 | plot(forecast1,xlab="Time",ylab="Observations") 48 | lines(forecast1$fit,col="red",lty=2) 49 | lines(OutsampleTs,col="green",lty=2) 50 | } 51 | }) 52 | output$Plot2<-renderPlot({ 53 | TotalTS<-ts(MyData()[,Col()],start=Start(),frequency = Fre()) 54 | InsampleTs<-window(TotalTS,start = c(Start(),1),end=c((Hstar()-1),Fre())) 55 | OutsampleTs<-window(TotalTS,start=c(Hstar(),1),end = c(Hend(),Fre())) 56 | 57 | if(input$F2==1){ 58 | forecast1<-ses(InsampleTs,h=length(OutsampleTs),level = input$CI) 59 | barplot(accuracy(forecast1,OutsampleTs),legend=rownames(accuracy(forecast1,OutsampleTs)),main="Accuracy Test",beside=TRUE, col=c("red","blue")) 60 | } 61 | if(input$F2==2){ 62 | forecast1<-ses(InsampleTs,h=length(OutsampleTs),initial = "simple",level = input$CI,alpha = input$AlphaS) 63 | barplot(accuracy(forecast1,OutsampleTs),legend=rownames(accuracy(forecast1,OutsampleTs)),main="Accuracy Test",beside=TRUE, col=c("red","blue")) 64 | } 65 | }) 66 | output$accu1 <-renderTable({ 67 | 68 | TotalTS<-ts(MyData()[,Col()],start=Start(),frequency = Fre()) 69 | InsampleTs<-window(TotalTS,start = c(Start(),1),end=c((Hstar()-1),Fre())) 70 | OutsampleTs<-window(TotalTS,start=c(Hstar(),1),end = c(Hend(),Fre())) 71 | 72 | if(input$F2==1){ 73 | forecast1<-ses(InsampleTs,h=length(OutsampleTs),level = input$CI) 74 | } 75 | if(input$F2==2){ 76 | forecast1<-ses(InsampleTs,h=length(OutsampleTs),initial = "simple",level = input$CI,alpha = input$AlphaS) 77 | } 78 | data.frame(Item=c('In Sample Error','Out Sample Error'),accuracy(forecast1,OutsampleTs)) 79 | 80 | 81 | }) 82 | 83 | output$Plot3<-renderPlot({ 84 | 85 | TotalTS<-ts(MyData()[,Col()],start=Start(),frequency = Fre()) 86 | InsampleTs<-window(TotalTS,start = c(Start(),1),end=c((Hstar()-1),Fre())) 87 | OutsampleTs<-window(TotalTS,start=c(Hstar(),1),end = c(Hend(),Fre())) 88 | 89 | if(input$F4==1){ 90 | forecast<-holt(InsampleTs,h=length(OutsampleTs),level = input$CI1) 91 | plot(forecast,xlab="Time",ylab="Observations") 92 | lines(forecast$fit,col="red",lty=2) 93 | lines(OutsampleTs,col="green",lty=2) 94 | } 95 | if(input$F4==2){ 96 | forecast<-holt(InsampleTs,h=length(OutsampleTs),level = input$CI1,initial = "simple",alpha = input$AlphaL,beta = input$BetaL) 97 | plot(forecast,xlab="Time",ylab="Observations") 98 | lines(forecast$fit,col="red",lty=2) 99 | lines(OutsampleTs,col="green",lty=2) 100 | } 101 | 102 | }) 103 | output$Plot4<-renderPlot({ 104 | TotalTS<-ts(MyData()[,Col()],start=Start(),frequency = Fre()) 105 | InsampleTs<-window(TotalTS,start = c(Start(),1),end=c((Hstar()-1),Fre())) 106 | OutsampleTs<-window(TotalTS,start=c(Hstar(),1),end = c(Hend(),Fre())) 107 | if(input$F4==1){ 108 | forecast2<-holt(InsampleTs,h=length(OutsampleTs),level = input$CI1) 109 | barplot(accuracy(forecast2,OutsampleTs),legend=rownames(accuracy(forecast2,OutsampleTs)),main="Accuracy Test",beside=TRUE, col=c("red","blue")) 110 | } 111 | if(input$F4==2){ 112 | forecast2<-holt(InsampleTs,h=length(OutsampleTs),level = input$CI1,initial = "simple",alpha = input$AlphaL,beta = input$BetaL) 113 | barplot(accuracy(forecast2,OutsampleTs),legend=rownames(accuracy(forecast2,OutsampleTs)),main="Accuracy Test",beside=TRUE, col=c("red","blue")) 114 | } 115 | }) 116 | 117 | output$accu2 <- renderTable({ 118 | 119 | TotalTS<-ts(MyData()[,Col()],start=Start(),frequency = Fre()) 120 | InsampleTs<-window(TotalTS,start = c(Start(),1),end=c((Hstar()-1),Fre())) 121 | OutsampleTs<-window(TotalTS,start=c(Hstar(),1),end = c(Hend(),Fre())) 122 | if(input$F4==1){ 123 | forecast2<-holt(InsampleTs,h=length(OutsampleTs),level = input$CI1) 124 | 125 | } 126 | if(input$F4==2){ 127 | forecast2<-holt(InsampleTs,h=length(OutsampleTs),level = input$CI1,initial = "simple",alpha = input$AlphaL,beta = input$BetaL) 128 | } 129 | 130 | data.frame(Item=c('In Sample Error','Out Sample Error'),accuracy(forecast2,OutsampleTs)) 131 | 132 | 133 | 134 | }) 135 | 136 | output$Plot5<-renderPlot({ 137 | TotalTS<-ts(MyData()[,Col()],start=Start(),frequency = Fre()) 138 | InsampleTs<-window(TotalTS,start = c(Start(),1),end=c((Hstar()-1),Fre())) 139 | OutsampleTs<-window(TotalTS,start=c(Hstar(),1),end = c(Hend(),Fre())) 140 | 141 | if(input$F6==1){ 142 | if(input$AM==1){ 143 | forecast3<-hw(InsampleTs,h=length(OutsampleTs),level = input$CI2) 144 | plot(forecast3) 145 | lines(forecast3$fit,col="red",lty=2) 146 | lines(OutsampleTs,col="green",lty=2) 147 | } 148 | if(input$AM==2){ 149 | forecast3<-hw(InsampleTs,h=length(OutsampleTs),level = input$CI2,"multiplicative") 150 | plot(forecast3) 151 | lines(forecast3$fit,col="red",lty=2) 152 | lines(OutsampleTs,col="green",lty=2) 153 | } 154 | } 155 | if(input$F6==2){ 156 | if(input$AM==1){ 157 | forecast3<-hw(InsampleTs,h=length(OutsampleTs),level = input$CI2,initial = "simple",alpha = input$AlphaH,beta = input$BetaH,gamma = input$GammaH) 158 | plot(forecast3) 159 | lines(forecast3$fit,col="red",lty=2) 160 | lines(OutsampleTs,col="green",lty=2) 161 | } 162 | if(input$AM==2){ 163 | forecast3<-hw(InsampleTs,h=length(OutsampleTs),level = input$CI2,"multiplicative",initial = "simple",alpha = input$AlphaH,beta = input$BetaH,gamma = input$GammaH) 164 | plot(forecast3) 165 | lines(forecast3$fit,col="red",lty=2) 166 | lines(OutsampleTs,col="green",lty=2) 167 | } 168 | } 169 | 170 | }) 171 | output$Plot6<-renderPlot({ 172 | 173 | TotalTS<-ts(MyData()[,Col()],start=Start(),frequency = Fre()) 174 | InsampleTs<-window(TotalTS,start = c(Start(),1),end=c((Hstar()-1),Fre())) 175 | OutsampleTs<-window(TotalTS,start=c(Hstar(),1),end = c(Hend(),Fre())) 176 | 177 | 178 | if(input$F6==1){ 179 | if(input$AM==1){ 180 | forecast3<-hw(InsampleTs,h=length(OutsampleTs),level = input$CI2) 181 | barplot(accuracy(forecast3,OutsampleTs),legend=rownames(accuracy(forecast3,OutsampleTs)),main="Accuracy",beside=TRUE, col=c("red","blue")) 182 | } 183 | if(input$AM==2){ 184 | forecast3<-hw(InsampleTs,h=length(OutsampleTs),level = input$CI2,"multiplicative") 185 | barplot(accuracy(forecast3,OutsampleTs),legend=rownames(accuracy(forecast3,OutsampleTs)),main="Accuracy",beside=TRUE, col=c("red","blue")) 186 | } 187 | } 188 | if(input$F6==2){ 189 | if(input$AM==1){ 190 | forecast3<-hw(InsampleTs,h=length(OutsampleTs),level = input$CI2,initial = "simple",alpha = input$AlphaH,beta = input$BetaH,gamma = input$GammaH) 191 | barplot(accuracy(forecast3,OutsampleTs),legend=rownames(accuracy(forecast3,OutsampleTs)),main="Accuracy",beside=TRUE, col=c("red","blue")) 192 | } 193 | if(input$AM==2){ 194 | forecast3<-hw(InsampleTs,h=length(OutsampleTs),level = input$CI2,"multiplicative",initial = "simple",alpha = input$AlphaH,beta = input$BetaH,gamma = input$GammaH) 195 | barplot(accuracy(forecast3,OutsampleTs),legend=rownames(accuracy(forecast3,OutsampleTs)),main="Accuracy",beside=TRUE, col=c("red","blue")) 196 | } 197 | } 198 | }) 199 | output$accu3 <- renderTable({ 200 | 201 | 202 | TotalTS<-ts(MyData()[,Col()],start=Start(),frequency = Fre()) 203 | InsampleTs<-window(TotalTS,start = c(Start(),1),end=c((Hstar()-1),Fre())) 204 | OutsampleTs<-window(TotalTS,start=c(Hstar(),1),end = c(Hend(),Fre())) 205 | 206 | 207 | if(input$F6==1){ 208 | if(input$AM==1){ 209 | forecast3<-hw(InsampleTs,h=length(OutsampleTs),level = input$CI2) 210 | 211 | } 212 | if(input$AM==2){ 213 | forecast3<-hw(InsampleTs,h=length(OutsampleTs),level = input$CI2,"multiplicative") 214 | } 215 | } 216 | if(input$F6==2){ 217 | if(input$AM==1){ 218 | forecast3<-hw(InsampleTs,h=length(OutsampleTs),level = input$CI2,initial = "simple",alpha = input$AlphaH,beta = input$BetaH,gamma = input$GammaH) 219 | } 220 | if(input$AM==2){ 221 | forecast3<-hw(InsampleTs,h=length(OutsampleTs),level = input$CI2,"multiplicative",initial = "simple",alpha = input$AlphaH,beta = input$BetaH,gamma = input$GammaH) 222 | } 223 | } 224 | data.frame(Item=c('In Sample Error','Out Sample Error'),accuracy(forecast3,OutsampleTs)) 225 | 226 | }) 227 | 228 | 229 | output$Plot7<-renderPlot({ 230 | TotalTS<-ts(MyData()[,Col()],start=Start(),frequency = Fre()) 231 | InsampleTs<-window(TotalTS,start = c(Start(),1),end=c((Hstar()-1),Fre())) 232 | OutsampleTs<-window(TotalTS,start=c(Hstar(),1),end = c(Hend(),Fre())) 233 | Endpoint<-time(InsampleTs)[length(time(InsampleTs))] 234 | if(input$Trans==2){ 235 | InsampleTs<-log(InsampleTs) 236 | } 237 | if(input$Trans==3){ 238 | InsampleTs<-InsampleTs^0.5 239 | } 240 | x<-time(InsampleTs) 241 | New<-data.frame(x=seq(Endpoint,Endpoint+(1/Fre())*length(OutsampleTs),by=1/Fre())) 242 | reg<-lm(InsampleTs~x) 243 | pred<-predict(reg,New,interval = "prediction",level=input$CI3) 244 | if(input$Trans==2){ 245 | plot(exp(InsampleTs),xlim=c(Start(),ceiling(Endpoint+(1/Fre())*length(OutsampleTs))),ylim=c(floor(min(exp(InsampleTs))),ceiling(exp(max(pred[,3])))))+points(New$x,exp(pred[,1]),pch=1) 246 | lines(New$x,exp(pred[,2]),lty=2,col="red") 247 | lines(New$x,exp(pred[,3]),lty=2,col="red") 248 | points(x,exp(reg$fitted.values),col="blue") 249 | 250 | } 251 | if(input$Trans==3){ 252 | plot(InsampleTs^2,xlim=c(Start(),ceiling(Endpoint+(1/Fre())*length(OutsampleTs))),ylim=c(floor(min((InsampleTs)^2)),ceiling(max(pred[,3])^2)))+points(New$x,(pred[,1])^2,pch=1) 253 | lines(New$x,(pred[,2])^2,lty=2,col="red") 254 | lines(New$x,(pred[,3])^2,lty=2,col="red") 255 | points(x,reg$fitted.values^2,col="blue") 256 | } 257 | if(input$Trans==1){ 258 | plot(InsampleTs,xlim=c(Start(),ceiling(Endpoint+(1/Fre())*length(OutsampleTs))),ylim=c(floor(min(InsampleTs)),ceiling(max(pred[,3]))))+points(New$x,pred[,1],pch=1) 259 | lines(New$x,pred[,2],lty=2,col="red") 260 | lines(New$x,pred[,3],lty=2,col="red") 261 | abline(reg$coefficients,col="blue") 262 | } 263 | }) 264 | output$plot8<-renderPlot({ 265 | 266 | TotalTS<-ts(MyData()[,Col()],start=Start(),frequency = Fre()) 267 | InsampleTs<-window(TotalTS,start = c(Start(),1),end=c((Hstar()-1),Fre())) 268 | OutsampleTs<-window(TotalTS,start=c(Hstar(),1),end = c(Hend(),Fre())) 269 | Endpoint<-time(InsampleTs)[length(time(InsampleTs))] 270 | if(input$Trans==2){ 271 | InsampleTs<-log(InsampleTs) 272 | } 273 | if(input$Trans==3){ 274 | InsampleTs<-InsampleTs^0.5 275 | } 276 | x<-time(InsampleTs) 277 | New<-data.frame(x=seq(Endpoint,Endpoint+(1/Fre())*length(OutsampleTs),by=1/Fre())) 278 | reg<-lm(InsampleTs~x) 279 | pred<-predict(reg,New,interval = "prediction",level=input$CI3) 280 | if(input$Trans==2){ 281 | FR<-exp(pred[,1]) 282 | barplot(accuracy(FR,OutsampleTs),main="Outsample Accuracy of Forecasting") 283 | } 284 | if(input$Trans==3){ 285 | FR<-pred[,1]^2 286 | barplot(accuracy(FR,OutsampleTs),main="Outsample Accuracy of Forecasting") 287 | } 288 | if(input$Trans==1){ 289 | FR<-pred[,1] 290 | barplot(accuracy(FR,OutsampleTs),main="Outsample Accuracy of Forecasting") 291 | } 292 | }) 293 | output$accu4 <- renderTable({ 294 | 295 | 296 | 297 | TotalTS<-ts(MyData()[,Col()],start=Start(),frequency = Fre()) 298 | InsampleTs<-window(TotalTS,start = c(Start(),1),end=c((Hstar()-1),Fre())) 299 | OutsampleTs<-window(TotalTS,start=c(Hstar(),1),end = c(Hend(),Fre())) 300 | Endpoint<-time(InsampleTs)[length(time(InsampleTs))] 301 | if(input$Trans==2){ 302 | InsampleTs<-log(InsampleTs) 303 | } 304 | if(input$Trans==3){ 305 | InsampleTs<-InsampleTs^0.5 306 | } 307 | x<-time(InsampleTs) 308 | New<-data.frame(x=seq(Endpoint,Endpoint+(1/Fre())*length(OutsampleTs),by=1/Fre())) 309 | reg<-lm(InsampleTs~x) 310 | pred<-predict(reg,New,interval = "prediction",level=input$CI3) 311 | if(input$Trans==2){ 312 | FR<-exp(pred[,1]) 313 | 314 | } 315 | if(input$Trans==3){ 316 | FR<-pred[,1]^2 317 | 318 | } 319 | if(input$Trans==1){ 320 | FR<-pred[,1] 321 | 322 | } 323 | data.frame(Item=c('Out Sample Error'),accuracy(FR,OutsampleTs)) 324 | 325 | }) 326 | 327 | output$Plot9<-renderPlot({ 328 | TotalTS<-ts(MyData()[,Col()],start=Start(),frequency = Fre()) 329 | InsampleTs<-window(TotalTS,start = c(Start(),1),end=c((Hstar()-1),Fre())) 330 | OutsampleTs<-window(TotalTS,start=c(Hstar(),1),end = c(Hend(),Fre())) 331 | forecast5<-forecast(nnetar(InsampleTs,level = input$CI4,h=length(OutsampleTs))) 332 | plot(forecast5) 333 | lines(forecast5$fit,col="red",lty=2) 334 | lines(OutsampleTs,col="green",lty=2) 335 | 336 | }) 337 | output$Plot10<-renderPlot({ 338 | TotalTS<-ts(MyData()[,Col()],start=Start(),frequency = Fre()) 339 | InsampleTs<-window(TotalTS,start = c(Start(),1),end=c((Hstar()-1),Fre())) 340 | OutsampleTs<-window(TotalTS,start=c(Hstar(),1),end = c(Hend(),Fre())) 341 | forecast5<-forecast(nnetar(InsampleTs,level = input$CI4,h=length(OutsampleTs))) 342 | barplot(accuracy(forecast5,OutsampleTs),legend=rownames(accuracy(forecast5,OutsampleTs)),main="Accuracy",beside=TRUE, col=c("red","blue")) 343 | 344 | }) 345 | output$accu5 <- renderTable({ 346 | TotalTS<-ts(MyData()[,Col()],start=Start(),frequency = Fre()) 347 | InsampleTs<-window(TotalTS,start = c(Start(),1),end=c((Hstar()-1),Fre())) 348 | OutsampleTs<-window(TotalTS,start=c(Hstar(),1),end = c(Hend(),Fre())) 349 | forecast5<-forecast(nnetar(InsampleTs,level = input$CI4,h=length(OutsampleTs))) 350 | data.frame(Item=c('In Sample Error','Out Sample Error'),accuracy(forecast5,OutsampleTs)) 351 | }) 352 | 353 | output$Plot11<- renderPlot({ 354 | 355 | TotalTS<-ts(MyData()[,Col()],start=Start(),frequency = Fre()) 356 | InsampleTs<-window(TotalTS,start = c(Start(),1),end=c((Hstar()-1),Fre())) 357 | OutsampleTs<-window(TotalTS,start=c(Hstar(),1),end = c(Hend(),Fre())) 358 | forecast6<-auto.arima(InsampleTs) 359 | plot(forecast(forecast6,level = input$CI5,h=length(OutsampleTs))) 360 | lines(fitted(forecast6),col="red",lty=2) 361 | lines(OutsampleTs,col="green",lty=2) 362 | 363 | 364 | }) 365 | output$Plot12 <- renderPlot({ 366 | TotalTS<-ts(MyData()[,Col()],start=Start(),frequency = Fre()) 367 | InsampleTs<-window(TotalTS,start = c(Start(),1),end=c((Hstar()-1),Fre())) 368 | OutsampleTs<-window(TotalTS,start=c(Hstar(),1),end = c(Hend(),Fre())) 369 | forecast6<-forecast(auto.arima(InsampleTs),level = input$CI5,h=length(OutsampleTs)) 370 | barplot(accuracy(forecast6,OutsampleTs),legend=rownames(accuracy(forecast6,OutsampleTs)),main="Accuracy",beside=TRUE, col=c("red","blue")) 371 | 372 | 373 | }) 374 | output$accu6 <- renderTable({ 375 | TotalTS<-ts(MyData()[,Col()],start=Start(),frequency = Fre()) 376 | InsampleTs<-window(TotalTS,start = c(Start(),1),end=c((Hstar()-1),Fre())) 377 | OutsampleTs<-window(TotalTS,start=c(Hstar(),1),end = c(Hend(),Fre())) 378 | forecast6<-forecast(auto.arima(InsampleTs),level = input$CI5,h=length(OutsampleTs)) 379 | data.frame(Item=c('In Sample Error','Out Sample Error'),accuracy(forecast6,OutsampleTs)) 380 | }) 381 | 382 | ### 383 | 384 | output$Plot0<- renderPlot({ 385 | 386 | TotalTS<-ts(MyData()[,Col()],start=Start(),frequency = Fre()) 387 | InsampleTs<-window(TotalTS,start = c(Start(),1),end=c((Hstar()-1),Fre())) 388 | OutsampleTs<-window(TotalTS,start=c(Hstar(),1),end = c(Hend(),Fre())) 389 | forecast0<-naive(InsampleTs,h=length(OutsampleTs)) 390 | plot(forecast(forecast0,h=length(OutsampleTs))) 391 | lines(forecast0$fit,col="red",lty=2) 392 | lines(OutsampleTs,col="green",lty=2) 393 | 394 | 395 | }) 396 | output$Plot00 <- renderPlot({ 397 | TotalTS<-ts(MyData()[,Col()],start=Start(),frequency = Fre()) 398 | InsampleTs<-window(TotalTS,start = c(Start(),1),end=c((Hstar()-1),Fre())) 399 | OutsampleTs<-window(TotalTS,start=c(Hstar(),1),end = c(Hend(),Fre())) 400 | forecast0<-naive(InsampleTs,h=length(OutsampleTs)) 401 | barplot(accuracy(forecast0,OutsampleTs),legend=rownames(accuracy(forecast0,OutsampleTs)),main="Accuracy",beside=TRUE, col=c("red","blue")) 402 | 403 | 404 | }) 405 | output$accu0 <- renderTable({ 406 | TotalTS<-ts(MyData()[,Col()],start=Start(),frequency = Fre()) 407 | InsampleTs<-window(TotalTS,start = c(Start(),1),end=c((Hstar()-1),Fre())) 408 | OutsampleTs<-window(TotalTS,start=c(Hstar(),1),end = c(Hend(),Fre())) 409 | forecast0<-naive(InsampleTs,h=length(OutsampleTs)) 410 | data.frame(Item=c('In Sample Error','Out Sample Error'),accuracy(forecast0,OutsampleTs)) 411 | }) 412 | 413 | 414 | 415 | }) 416 | 417 | 418 | --------------------------------------------------------------------------------