We want constant seasonal variation. Magnitude of swing constant through time.

We use different transformations to get a constant(additive) seasonal variation.

6.4 Modeling Seasonal Variation dummy variables and trig function Default: one group already built into intercept

data(airpass)
attach(airpass)
head(airpass)
justyear <- floor(airpass$year)
modecimal <- airpass$year - justyear  #month as a decimal
mofactor <-factor(round(modecimal*12)) 
# Check your work so far
cbind(airpass$year, mofactor)

# Changes levels of factor to be mo names 
levels(mofactor) <- c("Jan", "Feb", "Mar", "Apr", "May", 
                      "Jun", "Jul", "Aug", "Sep", "Oct",
                      "Nov", "Dec")  
summary(mofactor)
# Create model using dummy for each month
mod <- lm(log(pass) ~ justyear + mofactor, data=airpass)
coef(mod)
 (Intercept)     justyear  mofactorFeb  mofactorMar  mofactorApr  mofactorMay  mofactorJun  mofactorJul 
-1.214997885  0.120825657  0.031389870  0.019403852  0.159699778  0.138499729  0.146195892  0.278410898 
 mofactorAug  mofactorSep  mofactorOct  mofactorNov  mofactorDec 
 0.392422029  0.393195995  0.258630198  0.130540762 -0.003108143 
summary(mod)

Call:
lm(formula = log(pass) ~ justyear + mofactor, data = airpass)

Residuals:
      Min        1Q    Median        3Q       Max 
-0.156370 -0.041016  0.003677  0.044069  0.132324 

Coefficients:
             Estimate Std. Error t value Pr(>|t|)    
(Intercept) -1.214998   0.081277 -14.949  < 2e-16 ***
justyear     0.120826   0.001432  84.399  < 2e-16 ***
mofactorFeb  0.031390   0.024253   1.294    0.198    
mofactorMar  0.019404   0.024253   0.800    0.425    
mofactorApr  0.159700   0.024253   6.585 1.00e-09 ***
mofactorMay  0.138500   0.024253   5.711 7.19e-08 ***
mofactorJun  0.146196   0.024253   6.028 1.58e-08 ***
mofactorJul  0.278411   0.024253  11.480  < 2e-16 ***
mofactorAug  0.392422   0.024253  16.180  < 2e-16 ***
mofactorSep  0.393196   0.024253  16.212  < 2e-16 ***
mofactorOct  0.258630   0.024253  10.664  < 2e-16 ***
mofactorNov  0.130541   0.024253   5.382 3.28e-07 ***
mofactorDec -0.003108   0.024253  -0.128    0.898    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.0593 on 131 degrees of freedom
Multiple R-squared:  0.9835,    Adjusted R-squared:  0.982 
F-statistic: 649.4 on 12 and 131 DF,  p-value: < 2.2e-16

How can we tell the summer months have more passengers than January? How can we tell the winter months are similar to January wrt number of passengers? We can plot all of the models together in one graph

with(airpass, plot(log(pass)~ year, type="l" ))
lines(airpass$year, mod$fitted.values,col="blue")

Create a new factor: season (winter, spring, summer, fall) Then create model with these 4 dummies (rather than the 12) Hint!! You can collapse several categories into one. Use the example below. We start with “messy” data. We know that Y and Yes are the same.

x <- c("Y", "Y", "Yes", "N", "No")
x <- factor(x)
levels(x) <- list(Yes=c("Y", "Yes"), No=c("N", "No"))

Collapse the seasons

x<-factor(mofactor)
levels(x)<-list(Winter=c("Dec","Jan","Feb"),Spring=c("Mar","Apr","May"),Summer=c("Jun","Jul","Aug"),Fall=c("Sep","Oct","Nov"))
summary(x)
Winter Spring Summer   Fall 
    36     36     36     36 

Peer Review During the last part of our class, we had a chance to switch our project with a peer. Some useful feedback I heard was: organization, lit review and the year of the data. My project lacked the length because we were missing the lit review. My partner mentioned that including the lit review will help with the length and strengthen our predictions. Organization wise, she mentioned that we had result included in the method’s section. Lastly was the year of the data. We forgot to specify when our data was from. We made the changes prior to our project presentation. We will also make notes of the feedback in our final presentation in order for the final product to be of quality.

LS0tCnRpdGxlOiAiU2Vhc29uYWwgVmFyaWF0aW9uIgpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sKLS0tCgpXZSB3YW50IGNvbnN0YW50IHNlYXNvbmFsIHZhcmlhdGlvbi4gTWFnbml0dWRlIG9mIHN3aW5nIGNvbnN0YW50IHRocm91Z2ggdGltZS4KYGBge3J9CmxpYnJhcnkoZmFyYXdheSkKZGF0YSgiYWlycGFzcyIpCmF0dGFjaChhaXJwYXNzKQpuYW1lcyhhaXJwYXNzKQpwbG90KHBhc3N+eWVhcix0eXBlPSJsIikKcGxvdDE8LXBsb3QobG9nKHBhc3MpfmxvZyh5ZWFyKSx0eXBlPSJsIikKcGxvdChwbG90MSkKbGlicmFyeShhbHIzKQpkYXRhKCJNaXRjaGVsbCIpCmF0dGFjaChNaXRjaGVsbCkKbmFtZXMoTWl0Y2hlbGwpCnBsb3QoVGVtcH5Nb250aCx0eXBlPSJsIikKYGBgCldlIHVzZSBkaWZmZXJlbnQgdHJhbnNmb3JtYXRpb25zIHRvIGdldCBhIGNvbnN0YW50KGFkZGl0aXZlKSBzZWFzb25hbCB2YXJpYXRpb24uCgo2LjQgTW9kZWxpbmcgU2Vhc29uYWwgVmFyaWF0aW9uCmR1bW15IHZhcmlhYmxlcyBhbmQgdHJpZyBmdW5jdGlvbgpEZWZhdWx0OiBvbmUgZ3JvdXAgYWxyZWFkeSBidWlsdCBpbnRvIGludGVyY2VwdAoKYGBge3J9CmRhdGEoYWlycGFzcykKYXR0YWNoKGFpcnBhc3MpCmhlYWQoYWlycGFzcykKanVzdHllYXIgPC0gZmxvb3IoYWlycGFzcyR5ZWFyKQptb2RlY2ltYWwgPC0gYWlycGFzcyR5ZWFyIC0ganVzdHllYXIgICNtb250aCBhcyBhIGRlY2ltYWwKbW9mYWN0b3IgPC1mYWN0b3Iocm91bmQobW9kZWNpbWFsKjEyKSkgCiMgQ2hlY2sgeW91ciB3b3JrIHNvIGZhcgpjYmluZChhaXJwYXNzJHllYXIsIG1vZmFjdG9yKQoKIyBDaGFuZ2VzIGxldmVscyBvZiBmYWN0b3IgdG8gYmUgbW8gbmFtZXMgCmxldmVscyhtb2ZhY3RvcikgPC0gYygiSmFuIiwgIkZlYiIsICJNYXIiLCAiQXByIiwgIk1heSIsIAogICAgICAgICAgICAgICAgICAgICAgIkp1biIsICJKdWwiLCAiQXVnIiwgIlNlcCIsICJPY3QiLAogICAgICAgICAgICAgICAgICAgICAgIk5vdiIsICJEZWMiKSAgCnN1bW1hcnkobW9mYWN0b3IpCmBgYAoKYGBge3J9CiMgQ3JlYXRlIG1vZGVsIHVzaW5nIGR1bW15IGZvciBlYWNoIG1vbnRoCm1vZCA8LSBsbShsb2cocGFzcykgfiBqdXN0eWVhciArIG1vZmFjdG9yLCBkYXRhPWFpcnBhc3MpCmNvZWYobW9kKQpzdW1tYXJ5KG1vZCkKYGBgCgpIb3cgY2FuIHdlIHRlbGwgdGhlIHN1bW1lciBtb250aHMgaGF2ZSBtb3JlIHBhc3NlbmdlcnMgdGhhbiBKYW51YXJ5PwpIb3cgY2FuIHdlIHRlbGwgdGhlIHdpbnRlciBtb250aHMgYXJlIHNpbWlsYXIgdG8gSmFudWFyeSB3cnQgbnVtYmVyIG9mIHBhc3NlbmdlcnM/CldlIGNhbiBwbG90IGFsbCBvZiB0aGUgbW9kZWxzIHRvZ2V0aGVyIGluIG9uZSBncmFwaApgYGB7cn0Kd2l0aChhaXJwYXNzLCBwbG90KGxvZyhwYXNzKX4geWVhciwgdHlwZT0ibCIgKSkKbGluZXMoYWlycGFzcyR5ZWFyLCBtb2QkZml0dGVkLnZhbHVlcyxjb2w9ImJsdWUiKQpgYGAKCkNyZWF0ZSBhIG5ldyBmYWN0b3I6IHNlYXNvbiAod2ludGVyLCBzcHJpbmcsIHN1bW1lciwgZmFsbCkKVGhlbiBjcmVhdGUgbW9kZWwgd2l0aCB0aGVzZSA0IGR1bW1pZXMgKHJhdGhlciB0aGFuIHRoZSAxMikKSGludCEhIFlvdSBjYW4gY29sbGFwc2Ugc2V2ZXJhbCBjYXRlZ29yaWVzIGludG8gb25lLiBVc2UgdGhlIGV4YW1wbGUgYmVsb3cuCldlIHN0YXJ0IHdpdGggIm1lc3N5IiBkYXRhLiBXZSBrbm93IHRoYXQgWSBhbmQgWWVzIGFyZSB0aGUgc2FtZS4KCmBgYHtyfQp4IDwtIGMoIlkiLCAiWSIsICJZZXMiLCAiTiIsICJObyIpCnggPC0gZmFjdG9yKHgpCmxldmVscyh4KSA8LSBsaXN0KFllcz1jKCJZIiwgIlllcyIpLCBObz1jKCJOIiwgIk5vIikpCgpgYGAKQ29sbGFwc2UgdGhlIHNlYXNvbnMKYGBge3J9Cng8LWZhY3Rvcihtb2ZhY3RvcikKbGV2ZWxzKHgpPC1saXN0KFdpbnRlcj1jKCJEZWMiLCJKYW4iLCJGZWIiKSxTcHJpbmc9YygiTWFyIiwiQXByIiwiTWF5IiksU3VtbWVyPWMoIkp1biIsIkp1bCIsIkF1ZyIpLEZhbGw9YygiU2VwIiwiT2N0IiwiTm92IikpCnN1bW1hcnkoeCkKYGBgCgpgYGB7cn0KIyB0cmlnIAogIGFpcnBhc3Mkc2lucGllY2UgPC0gc2luKDIqcGkqYWlycGFzcyR5ZWFyLzEyKQogIGFpcnBhc3MkY29zcGllY2UgPC0gY29zKDIqcGkqYWlycGFzcyR5ZWFyLzEyKQogIGFpcnBhc3Mkc2lucGllY2UyIDwtIHNpbig0KnBpKmFpcnBhc3MkeWVhci8xMikKICBhaXJwYXNzJGNvc3BpZWNlMiA8LSBjb3MoNCpwaSphaXJwYXNzJHllYXIvMTIpCgoKdHJpZ21vZCA8LSBsbShsb2cocGFzcykgfiB5ZWFyICsgc2lucGllY2UgKyBjb3NwaWVjZSAsIGRhdGEgPSBhaXJwYXNzKQpzdW1tYXJ5KHRyaWdtb2QpCgpwbG90KGxvZyhwYXNzKX4geWVhciwgdHlwZT0ibCIgKQpsaW5lcyhhaXJwYXNzJHllYXIsIHRyaWdtb2QkZml0dGVkLnZhbHVlcyxjb2w9InJlZCIpCgp0cmlnbW9kMiA8LSBsbShsb2cocGFzcykgfiB5ZWFyICsgc2lucGllY2UgKyBjb3NwaWVjZSArIHNpbnBpZWNlMiArIGNvc3BpZWNlMiAsIGRhdGEgPSBhaXJwYXNzKQpzdW1tYXJ5KHRyaWdtb2QyKQoKcGxvdChsb2cocGFzcyl+IHllYXIsIHR5cGU9ImwiICkKbGluZXMoYWlycGFzcyR5ZWFyLCB0cmlnbW9kMiRmaXR0ZWQudmFsdWVzLGNvbD0icmVkIikKbGluZXMoYWlycGFzcyR5ZWFyLCB0cmlnbW9kJGZpdHRlZC52YWx1ZXMsY29sPSJibHVlIikKYGBgClBlZXIgUmV2aWV3CkR1cmluZyB0aGUgbGFzdCBwYXJ0IG9mIG91ciBjbGFzcywgd2UgaGFkIGEgY2hhbmNlIHRvIHN3aXRjaCBvdXIgcHJvamVjdCB3aXRoIGEgcGVlci4gU29tZSB1c2VmdWwgZmVlZGJhY2sgSSBoZWFyZCB3YXM6IG9yZ2FuaXphdGlvbiwgbGl0IHJldmlldyBhbmQgdGhlIHllYXIgb2YgdGhlIGRhdGEuIE15IHByb2plY3QgbGFja2VkIHRoZSBsZW5ndGggYmVjYXVzZSB3ZSB3ZXJlIG1pc3NpbmcgdGhlIGxpdCByZXZpZXcuIE15IHBhcnRuZXIgbWVudGlvbmVkIHRoYXQgaW5jbHVkaW5nIHRoZSBsaXQgcmV2aWV3IHdpbGwgaGVscCB3aXRoIHRoZSBsZW5ndGggYW5kIHN0cmVuZ3RoZW4gb3VyIHByZWRpY3Rpb25zLiBPcmdhbml6YXRpb24gd2lzZSwgc2hlIG1lbnRpb25lZCB0aGF0IHdlIGhhZCByZXN1bHQgaW5jbHVkZWQgaW4gdGhlIG1ldGhvZCdzIHNlY3Rpb24uIExhc3RseSB3YXMgdGhlIHllYXIgb2YgdGhlIGRhdGEuIFdlIGZvcmdvdCB0byBzcGVjaWZ5IHdoZW4gb3VyIGRhdGEgd2FzIGZyb20uIFdlIG1hZGUgdGhlIGNoYW5nZXMgcHJpb3IgdG8gb3VyIHByb2plY3QgcHJlc2VudGF0aW9uLiBXZSB3aWxsIGFsc28gbWFrZSBub3RlcyBvZiB0aGUgZmVlZGJhY2sgaW4gb3VyIGZpbmFsIHByZXNlbnRhdGlvbiBpbiBvcmRlciBmb3IgdGhlIGZpbmFsIHByb2R1Y3QgdG8gYmUgb2YgcXVhbGl0eS4gCgoKCgoK