Instructions

Your final is due by the end of day on 5/20/2018 You should post your solutions to your GitHub account or RPubs. You are also expected to make a short presentation via YouTube and post that recording to the board. This project will show off your ability to understand the elements of the class.

You are to register for Kaggle.com (free) and compete in the House Prices: Advanced Regression Techniques competition. https://www.kaggle.com/c/house-prices-advanced-regression-techniques . I want you to do the following.

Data Reading and Libraries

library(tidyverse)
library(ggthemes)
library(knitr)
library(caret)
library(e1071)
library(glmnet)
df <- read_csv('train.csv')
df[sapply(df, is.character)] <- lapply(df[sapply(df, is.character)], as.factor)

The data Frame

glimpse(df)
## Observations: 1,460
## Variables: 81
## $ Id            <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 1...
## $ MSSubClass    <int> 60, 20, 60, 70, 60, 50, 20, 60, 50, 190, 20, 60,...
## $ MSZoning      <fct> RL, RL, RL, RL, RL, RL, RL, RL, RM, RL, RL, RL, ...
## $ LotFrontage   <int> 65, 80, 68, 60, 84, 85, 75, NA, 51, 50, 70, 85, ...
## $ LotArea       <int> 8450, 9600, 11250, 9550, 14260, 14115, 10084, 10...
## $ Street        <fct> Pave, Pave, Pave, Pave, Pave, Pave, Pave, Pave, ...
## $ Alley         <fct> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ...
## $ LotShape      <fct> Reg, Reg, IR1, IR1, IR1, IR1, Reg, IR1, Reg, Reg...
## $ LandContour   <fct> Lvl, Lvl, Lvl, Lvl, Lvl, Lvl, Lvl, Lvl, Lvl, Lvl...
## $ Utilities     <fct> AllPub, AllPub, AllPub, AllPub, AllPub, AllPub, ...
## $ LotConfig     <fct> Inside, FR2, Inside, Corner, FR2, Inside, Inside...
## $ LandSlope     <fct> Gtl, Gtl, Gtl, Gtl, Gtl, Gtl, Gtl, Gtl, Gtl, Gtl...
## $ Neighborhood  <fct> CollgCr, Veenker, CollgCr, Crawfor, NoRidge, Mit...
## $ Condition1    <fct> Norm, Feedr, Norm, Norm, Norm, Norm, Norm, PosN,...
## $ Condition2    <fct> Norm, Norm, Norm, Norm, Norm, Norm, Norm, Norm, ...
## $ BldgType      <fct> 1Fam, 1Fam, 1Fam, 1Fam, 1Fam, 1Fam, 1Fam, 1Fam, ...
## $ HouseStyle    <fct> 2Story, 1Story, 2Story, 2Story, 2Story, 1.5Fin, ...
## $ OverallQual   <int> 7, 6, 7, 7, 8, 5, 8, 7, 7, 5, 5, 9, 5, 7, 6, 7, ...
## $ OverallCond   <int> 5, 8, 5, 5, 5, 5, 5, 6, 5, 6, 5, 5, 6, 5, 5, 8, ...
## $ YearBuilt     <int> 2003, 1976, 2001, 1915, 2000, 1993, 2004, 1973, ...
## $ YearRemodAdd  <int> 2003, 1976, 2002, 1970, 2000, 1995, 2005, 1973, ...
## $ RoofStyle     <fct> Gable, Gable, Gable, Gable, Gable, Gable, Gable,...
## $ RoofMatl      <fct> CompShg, CompShg, CompShg, CompShg, CompShg, Com...
## $ Exterior1st   <fct> VinylSd, MetalSd, VinylSd, Wd Sdng, VinylSd, Vin...
## $ Exterior2nd   <fct> VinylSd, MetalSd, VinylSd, Wd Shng, VinylSd, Vin...
## $ MasVnrType    <fct> BrkFace, None, BrkFace, None, BrkFace, None, Sto...
## $ MasVnrArea    <int> 196, 0, 162, 0, 350, 0, 186, 240, 0, 0, 0, 286, ...
## $ ExterQual     <fct> Gd, TA, Gd, TA, Gd, TA, Gd, TA, TA, TA, TA, Ex, ...
## $ ExterCond     <fct> TA, TA, TA, TA, TA, TA, TA, TA, TA, TA, TA, TA, ...
## $ Foundation    <fct> PConc, CBlock, PConc, BrkTil, PConc, Wood, PConc...
## $ BsmtQual      <fct> Gd, Gd, Gd, TA, Gd, Gd, Ex, Gd, TA, TA, TA, Ex, ...
## $ BsmtCond      <fct> TA, TA, TA, Gd, TA, TA, TA, TA, TA, TA, TA, TA, ...
## $ BsmtExposure  <fct> No, Gd, Mn, No, Av, No, Av, Mn, No, No, No, No, ...
## $ BsmtFinType1  <fct> GLQ, ALQ, GLQ, ALQ, GLQ, GLQ, GLQ, ALQ, Unf, GLQ...
## $ BsmtFinSF1    <int> 706, 978, 486, 216, 655, 732, 1369, 859, 0, 851,...
## $ BsmtFinType2  <fct> Unf, Unf, Unf, Unf, Unf, Unf, Unf, BLQ, Unf, Unf...
## $ BsmtFinSF2    <int> 0, 0, 0, 0, 0, 0, 0, 32, 0, 0, 0, 0, 0, 0, 0, 0,...
## $ BsmtUnfSF     <int> 150, 284, 434, 540, 490, 64, 317, 216, 952, 140,...
## $ TotalBsmtSF   <int> 856, 1262, 920, 756, 1145, 796, 1686, 1107, 952,...
## $ Heating       <fct> GasA, GasA, GasA, GasA, GasA, GasA, GasA, GasA, ...
## $ HeatingQC     <fct> Ex, Ex, Ex, Gd, Ex, Ex, Ex, Ex, Gd, Ex, Ex, Ex, ...
## $ CentralAir    <fct> Y, Y, Y, Y, Y, Y, Y, Y, Y, Y, Y, Y, Y, Y, Y, Y, ...
## $ Electrical    <fct> SBrkr, SBrkr, SBrkr, SBrkr, SBrkr, SBrkr, SBrkr,...
## $ `1stFlrSF`    <int> 856, 1262, 920, 961, 1145, 796, 1694, 1107, 1022...
## $ `2ndFlrSF`    <int> 854, 0, 866, 756, 1053, 566, 0, 983, 752, 0, 0, ...
## $ LowQualFinSF  <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, ...
## $ GrLivArea     <int> 1710, 1262, 1786, 1717, 2198, 1362, 1694, 2090, ...
## $ BsmtFullBath  <int> 1, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 0, 1, 0, ...
## $ BsmtHalfBath  <int> 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, ...
## $ FullBath      <int> 2, 2, 2, 1, 2, 1, 2, 2, 2, 1, 1, 3, 1, 2, 1, 1, ...
## $ HalfBath      <int> 1, 0, 1, 0, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, ...
## $ BedroomAbvGr  <int> 3, 3, 3, 3, 4, 1, 3, 3, 2, 2, 3, 4, 2, 3, 2, 2, ...
## $ KitchenAbvGr  <int> 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 1, 1, 1, 1, 1, 1, ...
## $ KitchenQual   <fct> Gd, TA, Gd, Gd, Gd, TA, Gd, TA, TA, TA, TA, Ex, ...
## $ TotRmsAbvGrd  <int> 8, 6, 6, 7, 9, 5, 7, 7, 8, 5, 5, 11, 4, 7, 5, 5,...
## $ Functional    <fct> Typ, Typ, Typ, Typ, Typ, Typ, Typ, Typ, Min1, Ty...
## $ Fireplaces    <int> 0, 1, 1, 1, 1, 0, 1, 2, 2, 2, 0, 2, 0, 1, 1, 0, ...
## $ FireplaceQu   <fct> NA, TA, TA, Gd, TA, NA, Gd, TA, TA, TA, NA, Gd, ...
## $ GarageType    <fct> Attchd, Attchd, Attchd, Detchd, Attchd, Attchd, ...
## $ GarageYrBlt   <int> 2003, 1976, 2001, 1998, 2000, 1993, 2004, 1973, ...
## $ GarageFinish  <fct> RFn, RFn, RFn, Unf, RFn, Unf, RFn, RFn, Unf, RFn...
## $ GarageCars    <int> 2, 2, 2, 3, 3, 2, 2, 2, 2, 1, 1, 3, 1, 3, 1, 2, ...
## $ GarageArea    <int> 548, 460, 608, 642, 836, 480, 636, 484, 468, 205...
## $ GarageQual    <fct> TA, TA, TA, TA, TA, TA, TA, TA, Fa, Gd, TA, TA, ...
## $ GarageCond    <fct> TA, TA, TA, TA, TA, TA, TA, TA, TA, TA, TA, TA, ...
## $ PavedDrive    <fct> Y, Y, Y, Y, Y, Y, Y, Y, Y, Y, Y, Y, Y, Y, Y, Y, ...
## $ WoodDeckSF    <int> 0, 298, 0, 0, 192, 40, 255, 235, 90, 0, 0, 147, ...
## $ OpenPorchSF   <int> 61, 0, 42, 35, 84, 30, 57, 204, 0, 4, 0, 21, 0, ...
## $ EnclosedPorch <int> 0, 0, 0, 272, 0, 0, 0, 228, 205, 0, 0, 0, 0, 0, ...
## $ `3SsnPorch`   <int> 0, 0, 0, 0, 0, 320, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0...
## $ ScreenPorch   <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 176, 0, 0, 0...
## $ PoolArea      <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, ...
## $ PoolQC        <fct> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ...
## $ Fence         <fct> NA, NA, NA, NA, NA, MnPrv, NA, NA, NA, NA, NA, N...
## $ MiscFeature   <fct> NA, NA, NA, NA, NA, Shed, NA, Shed, NA, NA, NA, ...
## $ MiscVal       <int> 0, 0, 0, 0, 0, 700, 0, 350, 0, 0, 0, 0, 0, 0, 0,...
## $ MoSold        <int> 2, 5, 9, 2, 12, 10, 8, 11, 4, 1, 2, 7, 9, 8, 5, ...
## $ YrSold        <int> 2008, 2007, 2008, 2006, 2008, 2009, 2007, 2009, ...
## $ SaleType      <fct> WD, WD, WD, WD, WD, WD, WD, WD, WD, WD, WD, New,...
## $ SaleCondition <fct> Normal, Normal, Normal, Abnorml, Normal, Normal,...
## $ SalePrice     <int> 208500, 181500, 223500, 140000, 250000, 143000, ...
  • Pick one of the quantitative independent variables from the training data set (train.csv) , and define that variable as X. Make sure this variable is skewed to the right!
  • Pick the dependent variable and define it as Y
library(psych)
skewDF <- describe(df)
test <- skewDF %>% 
  select(skew) %>% 
  mutate(VarName = names(df)) %>% 
  arrange(desc(abs(skew))) %>% 
  head()
test

LotArea has a large skeww

ggplot(data = df, aes(x=LotArea)) + 
  geom_density(colour = ggthemes_data$solarized$base['base00'], 
               fill = ggthemes_data$solarized$accents['blue'], 
               alpha = 0.4) +
  theme_minimal() +
  ggtitle('Lot Area')

We can verify this skew with the summary of the data:

summary(df$LotArea)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    1300    7554    9478   10517   11602  215245

This has an obvious right skew.

Probability

Calculate as a minimum the below probabilities a through c. Assume the small letter “x” is estimated as the 1st quartile of the X variable, and the small letter “y” is estimated as the 1st quartile of the Y variable. Interpret the meaning of all probabilities. In addition, make a table of counts as shown below.

  1. \(P(X>x | Y>y)\) b. \(P(X>x, Y>y)\) c. \(P(X<x | Y>y)\)
  1. \(P(B|A) = \frac{P(A) \cup P(B)}{P(A)}\) Therefor, \(P(X>x | Y>y) = \frac{P( Y>y) \cup P(X>x)}{P(Y>y)}\)
# Vars
q1x <- quantile(df$LotArea, 0.25)
q1y <- quantile(df$SalePrice, 0.25)
x <- df %>% filter(LotArea > q1x ) %>% nrow() / nrow(df)
y <- df %>% filter(SalePrice > q1y) %>% nrow() / nrow(df)
xy <- df %>% filter(SalePrice > q1y & LotArea > q1x) %>% nrow()/nrow(df)

yx <- df %>% filter(SalePrice > q1y & LotArea < q1x) %>% nrow()/nrow(df)

a <- (xy)/(y)
b <- x*y
c <- yx/y

  1. The conditional probability is 0.8200913

  2. The joint probability is 0.5625

  3. The conditional prbability is 0.1799087

one <- df %>% filter(LotArea <= q1x & SalePrice <= q1y) %>% nrow()
two <- df %>% filter(LotArea > q1x & SalePrice <= q1y) %>% nrow()
three <- one + two
four <- df %>% filter(LotArea <= q1x & SalePrice > q1y) %>% nrow()
five <- df %>% filter(LotArea > q1x & SalePrice > q1y) %>% nrow()
six <- four + five
seven <- one + four
eight <- two + five
nine <- three + six
x/y <=1st quartile >1st quartile Total
<= 1st q 168 197 365
>1st q 197 898 1095
Total 365 1095 1460

Does splitting the training data in this fashion make them independent?

Let A be the new variable counting those observations above the 1st quartile for X, and let B be the new variable counting those observations above the 1st quartile for Y. Does \(P(A|B)=P(A)P(B)\)? Check mathematically, and then evaluate by running a Chi Square test for association.

A <- df %>% filter(LotArea > q1x ) %>% nrow()/ nrow(df)
B <- df %>% filter(SalePrice > q1y ) %>% nrow()/nrow(df)
AB <- df %>% filter(LotArea > q1x, SalePrice > q1y) %>% nrow() / nrow(df)

AB /B
## [1] 0.8200913
A*B
## [1] 0.5625
A
## [1] 0.75
B
## [1] 0.75

These results are different meaning that they are not independant because \(P(A|B)\neq P(A)\). Thus, splitting them like in the table above will not make them independant.

Chi Squared Test

chisq.test(df$LotArea, df$SalePrice)
## 
##  Pearson's Chi-squared test
## 
## data:  df$LotArea and df$SalePrice
## X-squared = 735090, df = 709660, p-value < 2.2e-16

Since the critical value of \(\chi\) is high, we reject the null hypothesis that they are independant. This comes at no surprise since the data are higly right skewed.

Descriptive and Inferential Statistics

Provide univariate descriptive statistics and appropriate plots for the training data set.

summary(df)
##        Id           MSSubClass       MSZoning     LotFrontage    
##  Min.   :   1.0   Min.   : 20.0   C (all):  10   Min.   : 21.00  
##  1st Qu.: 365.8   1st Qu.: 20.0   FV     :  65   1st Qu.: 59.00  
##  Median : 730.5   Median : 50.0   RH     :  16   Median : 69.00  
##  Mean   : 730.5   Mean   : 56.9   RL     :1151   Mean   : 70.05  
##  3rd Qu.:1095.2   3rd Qu.: 70.0   RM     : 218   3rd Qu.: 80.00  
##  Max.   :1460.0   Max.   :190.0                  Max.   :313.00  
##                                                  NA's   :259     
##     LotArea        Street      Alley      LotShape  LandContour
##  Min.   :  1300   Grvl:   6   Grvl:  50   IR1:484   Bnk:  63   
##  1st Qu.:  7554   Pave:1454   Pave:  41   IR2: 41   HLS:  50   
##  Median :  9478               NA's:1369   IR3: 10   Low:  36   
##  Mean   : 10517                           Reg:925   Lvl:1311   
##  3rd Qu.: 11602                                                
##  Max.   :215245                                                
##                                                                
##   Utilities      LotConfig    LandSlope   Neighborhood   Condition1  
##  AllPub:1459   Corner : 263   Gtl:1382   NAmes  :225   Norm   :1260  
##  NoSeWa:   1   CulDSac:  94   Mod:  65   CollgCr:150   Feedr  :  81  
##                FR2    :  47   Sev:  13   OldTown:113   Artery :  48  
##                FR3    :   4              Edwards:100   RRAn   :  26  
##                Inside :1052              Somerst: 86   PosN   :  19  
##                                          Gilbert: 79   RRAe   :  11  
##                                          (Other):707   (Other):  15  
##    Condition2     BldgType      HouseStyle   OverallQual    
##  Norm   :1445   1Fam  :1220   1Story :726   Min.   : 1.000  
##  Feedr  :   6   2fmCon:  31   2Story :445   1st Qu.: 5.000  
##  Artery :   2   Duplex:  52   1.5Fin :154   Median : 6.000  
##  PosN   :   2   Twnhs :  43   SLvl   : 65   Mean   : 6.099  
##  RRNn   :   2   TwnhsE: 114   SFoyer : 37   3rd Qu.: 7.000  
##  PosA   :   1                 1.5Unf : 14   Max.   :10.000  
##  (Other):   2                 (Other): 19                   
##   OverallCond      YearBuilt     YearRemodAdd    RoofStyle   
##  Min.   :1.000   Min.   :1872   Min.   :1950   Flat   :  13  
##  1st Qu.:5.000   1st Qu.:1954   1st Qu.:1967   Gable  :1141  
##  Median :5.000   Median :1973   Median :1994   Gambrel:  11  
##  Mean   :5.575   Mean   :1971   Mean   :1985   Hip    : 286  
##  3rd Qu.:6.000   3rd Qu.:2000   3rd Qu.:2004   Mansard:   7  
##  Max.   :9.000   Max.   :2010   Max.   :2010   Shed   :   2  
##                                                              
##     RoofMatl     Exterior1st   Exterior2nd    MasVnrType    MasVnrArea    
##  CompShg:1434   VinylSd:515   VinylSd:504   BrkCmn : 15   Min.   :   0.0  
##  Tar&Grv:  11   HdBoard:222   MetalSd:214   BrkFace:445   1st Qu.:   0.0  
##  WdShngl:   6   MetalSd:220   HdBoard:207   None   :864   Median :   0.0  
##  WdShake:   5   Wd Sdng:206   Wd Sdng:197   Stone  :128   Mean   : 103.7  
##  ClyTile:   1   Plywood:108   Plywood:142   NA's   :  8   3rd Qu.: 166.0  
##  Membran:   1   CemntBd: 61   CmentBd: 60                 Max.   :1600.0  
##  (Other):   2   (Other):128   (Other):136                 NA's   :8       
##  ExterQual ExterCond  Foundation  BsmtQual   BsmtCond    BsmtExposure
##  Ex: 52    Ex:   3   BrkTil:146   Ex  :121   Fa  :  45   Av  :221    
##  Fa: 14    Fa:  28   CBlock:634   Fa  : 35   Gd  :  65   Gd  :134    
##  Gd:488    Gd: 146   PConc :647   Gd  :618   Po  :   2   Mn  :114    
##  TA:906    Po:   1   Slab  : 24   TA  :649   TA  :1311   No  :953    
##            TA:1282   Stone :  6   NA's: 37   NA's:  37   NA's: 38    
##                      Wood  :  3                                      
##                                                                      
##  BsmtFinType1   BsmtFinSF1     BsmtFinType2   BsmtFinSF2     
##  ALQ :220     Min.   :   0.0   ALQ :  19    Min.   :   0.00  
##  BLQ :148     1st Qu.:   0.0   BLQ :  33    1st Qu.:   0.00  
##  GLQ :418     Median : 383.5   GLQ :  14    Median :   0.00  
##  LwQ : 74     Mean   : 443.6   LwQ :  46    Mean   :  46.55  
##  Rec :133     3rd Qu.: 712.2   Rec :  54    3rd Qu.:   0.00  
##  Unf :430     Max.   :5644.0   Unf :1256    Max.   :1474.00  
##  NA's: 37                      NA's:  38                     
##    BsmtUnfSF       TotalBsmtSF      Heating     HeatingQC CentralAir
##  Min.   :   0.0   Min.   :   0.0   Floor:   1   Ex:741    N:  95    
##  1st Qu.: 223.0   1st Qu.: 795.8   GasA :1428   Fa: 49    Y:1365    
##  Median : 477.5   Median : 991.5   GasW :  18   Gd:241              
##  Mean   : 567.2   Mean   :1057.4   Grav :   7   Po:  1              
##  3rd Qu.: 808.0   3rd Qu.:1298.2   OthW :   2   TA:428              
##  Max.   :2336.0   Max.   :6110.0   Wall :   4                       
##                                                                     
##  Electrical      1stFlrSF       2ndFlrSF     LowQualFinSF    
##  FuseA:  94   Min.   : 334   Min.   :   0   Min.   :  0.000  
##  FuseF:  27   1st Qu.: 882   1st Qu.:   0   1st Qu.:  0.000  
##  FuseP:   3   Median :1087   Median :   0   Median :  0.000  
##  Mix  :   1   Mean   :1163   Mean   : 347   Mean   :  5.845  
##  SBrkr:1334   3rd Qu.:1391   3rd Qu.: 728   3rd Qu.:  0.000  
##  NA's :   1   Max.   :4692   Max.   :2065   Max.   :572.000  
##                                                              
##    GrLivArea     BsmtFullBath     BsmtHalfBath        FullBath    
##  Min.   : 334   Min.   :0.0000   Min.   :0.00000   Min.   :0.000  
##  1st Qu.:1130   1st Qu.:0.0000   1st Qu.:0.00000   1st Qu.:1.000  
##  Median :1464   Median :0.0000   Median :0.00000   Median :2.000  
##  Mean   :1515   Mean   :0.4253   Mean   :0.05753   Mean   :1.565  
##  3rd Qu.:1777   3rd Qu.:1.0000   3rd Qu.:0.00000   3rd Qu.:2.000  
##  Max.   :5642   Max.   :3.0000   Max.   :2.00000   Max.   :3.000  
##                                                                   
##     HalfBath       BedroomAbvGr    KitchenAbvGr   KitchenQual
##  Min.   :0.0000   Min.   :0.000   Min.   :0.000   Ex:100     
##  1st Qu.:0.0000   1st Qu.:2.000   1st Qu.:1.000   Fa: 39     
##  Median :0.0000   Median :3.000   Median :1.000   Gd:586     
##  Mean   :0.3829   Mean   :2.866   Mean   :1.047   TA:735     
##  3rd Qu.:1.0000   3rd Qu.:3.000   3rd Qu.:1.000              
##  Max.   :2.0000   Max.   :8.000   Max.   :3.000              
##                                                              
##   TotRmsAbvGrd    Functional    Fireplaces    FireplaceQu   GarageType 
##  Min.   : 2.000   Maj1:  14   Min.   :0.000   Ex  : 24    2Types :  6  
##  1st Qu.: 5.000   Maj2:   5   1st Qu.:0.000   Fa  : 33    Attchd :870  
##  Median : 6.000   Min1:  31   Median :1.000   Gd  :380    Basment: 19  
##  Mean   : 6.518   Min2:  34   Mean   :0.613   Po  : 20    BuiltIn: 88  
##  3rd Qu.: 7.000   Mod :  15   3rd Qu.:1.000   TA  :313    CarPort:  9  
##  Max.   :14.000   Sev :   1   Max.   :3.000   NA's:690    Detchd :387  
##                   Typ :1360                               NA's   : 81  
##   GarageYrBlt   GarageFinish   GarageCars      GarageArea     GarageQual 
##  Min.   :1900   Fin :352     Min.   :0.000   Min.   :   0.0   Ex  :   3  
##  1st Qu.:1961   RFn :422     1st Qu.:1.000   1st Qu.: 334.5   Fa  :  48  
##  Median :1980   Unf :605     Median :2.000   Median : 480.0   Gd  :  14  
##  Mean   :1979   NA's: 81     Mean   :1.767   Mean   : 473.0   Po  :   3  
##  3rd Qu.:2002                3rd Qu.:2.000   3rd Qu.: 576.0   TA  :1311  
##  Max.   :2010                Max.   :4.000   Max.   :1418.0   NA's:  81  
##  NA's   :81                                                              
##  GarageCond  PavedDrive   WoodDeckSF      OpenPorchSF     EnclosedPorch   
##  Ex  :   2   N:  90     Min.   :  0.00   Min.   :  0.00   Min.   :  0.00  
##  Fa  :  35   P:  30     1st Qu.:  0.00   1st Qu.:  0.00   1st Qu.:  0.00  
##  Gd  :   9   Y:1340     Median :  0.00   Median : 25.00   Median :  0.00  
##  Po  :   7              Mean   : 94.24   Mean   : 46.66   Mean   : 21.95  
##  TA  :1326              3rd Qu.:168.00   3rd Qu.: 68.00   3rd Qu.:  0.00  
##  NA's:  81              Max.   :857.00   Max.   :547.00   Max.   :552.00  
##                                                                           
##    3SsnPorch       ScreenPorch        PoolArea        PoolQC    
##  Min.   :  0.00   Min.   :  0.00   Min.   :  0.000   Ex  :   2  
##  1st Qu.:  0.00   1st Qu.:  0.00   1st Qu.:  0.000   Fa  :   2  
##  Median :  0.00   Median :  0.00   Median :  0.000   Gd  :   3  
##  Mean   :  3.41   Mean   : 15.06   Mean   :  2.759   NA's:1453  
##  3rd Qu.:  0.00   3rd Qu.:  0.00   3rd Qu.:  0.000              
##  Max.   :508.00   Max.   :480.00   Max.   :738.000              
##                                                                 
##    Fence      MiscFeature    MiscVal             MoSold      
##  GdPrv:  59   Gar2:   2   Min.   :    0.00   Min.   : 1.000  
##  GdWo :  54   Othr:   2   1st Qu.:    0.00   1st Qu.: 5.000  
##  MnPrv: 157   Shed:  49   Median :    0.00   Median : 6.000  
##  MnWw :  11   TenC:   1   Mean   :   43.49   Mean   : 6.322  
##  NA's :1179   NA's:1406   3rd Qu.:    0.00   3rd Qu.: 8.000  
##                           Max.   :15500.00   Max.   :12.000  
##                                                              
##      YrSold        SaleType    SaleCondition    SalePrice     
##  Min.   :2006   WD     :1267   Abnorml: 101   Min.   : 34900  
##  1st Qu.:2007   New    : 122   AdjLand:   4   1st Qu.:129975  
##  Median :2008   COD    :  43   Alloca :  12   Median :163000  
##  Mean   :2008   ConLD  :   9   Family :  20   Mean   :180921  
##  3rd Qu.:2009   ConLI  :   5   Normal :1198   3rd Qu.:214000  
##  Max.   :2010   ConLw  :   5   Partial: 125   Max.   :755000  
##                 (Other):   9
df %>% 
  select_if(is.numeric) %>% 
  gather() %>% 
  ggplot(aes(x=value)) +
  geom_histogram() +
  facet_wrap(~key, ncol = 4, scales = 'free') +
  theme_minimal()

df %>% 
  select_if(is.factor) %>% 
  gather() %>% 
  ggplot(aes(x=value)) +
  geom_bar(stat = 'count') +
  facet_wrap(~key, ncol = 4, scales = 'free') +
  theme_minimal()

Provide a scatterplot of X and Y.

ggplot(df, aes(LotArea, SalePrice))+
  geom_point(colour = 'skyblue', alpha = 0.3) +
  theme_minimal()

df %>% 
  select_if(is.numeric) %>% 
  gather(VariableName, Value, -SalePrice, -Id) %>% 
  ggplot(aes(SalePrice,Value))+
  geom_point(colour = 'gray28', alpha = 0.3) +
  facet_wrap(~VariableName, ncol = 4, scales = 'free') +
  theme_minimal()

df %>% 
  dplyr::select(which(sapply(.,class)=="factor"), SalePrice) %>% 
  gather(VariableName, Value, -SalePrice) %>%
  ggplot(aes(SalePrice,Value))+
  geom_point(colour = 'gray28', alpha = 0.3) +
  facet_wrap(~VariableName, ncol = 4, scales = 'free') +
  theme_minimal()

Derive a correlation matrix for any THREE quantitative variables in the dataset.

vars <- c('LotArea', 'SalePrice', 'GrLivArea')

corDF <- df %>% dplyr::select(LotArea, SalePrice, GrLivArea) %>% cor(use = "complete.obs")
corDF
##             LotArea SalePrice GrLivArea
## LotArea   1.0000000 0.2638434 0.2631162
## SalePrice 0.2638434 1.0000000 0.7086245
## GrLivArea 0.2631162 0.7086245 1.0000000
library(corrplot)
corrplot(corDF)

Test the hypotheses that the correlations between each pairwise set of variables is 0 and provide a 92% confidence interval.

testCor <- df %>% dplyr::select(LotArea, SalePrice, GrLivArea)
cor.test(testCor$LotArea, testCor$SalePrice, conf.level = 0.92)
## 
##  Pearson's product-moment correlation
## 
## data:  testCor$LotArea and testCor$SalePrice
## t = 10.445, df = 1458, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 92 percent confidence interval:
##  0.2206794 0.3059759
## sample estimates:
##       cor 
## 0.2638434
cor.test(testCor$LotArea, testCor$GrLivArea, conf.level = 0.92)
## 
##  Pearson's product-moment correlation
## 
## data:  testCor$LotArea and testCor$GrLivArea
## t = 10.414, df = 1458, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 92 percent confidence interval:
##  0.2199359 0.3052674
## sample estimates:
##       cor 
## 0.2631162
cor.test(testCor$SalePrice, testCor$GrLivArea, conf.level = 0.92)
## 
##  Pearson's product-moment correlation
## 
## data:  testCor$SalePrice and testCor$GrLivArea
## t = 38.348, df = 1458, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 92 percent confidence interval:
##  0.6850407 0.7307245
## sample estimates:
##       cor 
## 0.7086245

Discuss the meaning of your analysis.

All the correlations were significant.

Would you be worried about familywise error? Why or why not?

Familywise error is applicable when making multiple hypothesis tests.

\[ \alpha = 1 - (1-p)^c \] Where \(p\) is the confidence level and \(c\) is the number of tests.

Alpha <- 1 -  0.92^3
Alpha
## [1] 0.221312

So we have about a 22% chance of making a type one error. This is definitely something to be worried about, hwoever, given that the p values were below 0.08, we have less to worry about.

Linear Algebra and Correlation.

Invert your 3 x 3 correlation matrix from above.

(This is known as the precision matrix and contains variance inflation factors on the diagonal.)

corDFT <- t(corDF)
corDFT
##             LotArea SalePrice GrLivArea
## LotArea   1.0000000 0.2638434 0.2631162
## SalePrice 0.2638434 1.0000000 0.7086245
## GrLivArea 0.2631162 0.7086245 1.0000000

Multiply

the correlation matrix by the precision matrix, and then multiply the precision matrix by the correlation matrix.

corDF %*% corDFT
##             LotArea SalePrice GrLivArea
## LotArea   1.1388434 0.7141373 0.7131982
## SalePrice 0.7141373 1.5717620 1.4866704
## GrLivArea 0.7131982 1.4866704 1.5713788
corDFT %*% corDF
##             LotArea SalePrice GrLivArea
## LotArea   1.1388434 0.7141373 0.7131982
## SalePrice 0.7141373 1.5717620 1.4866704
## GrLivArea 0.7131982 1.4866704 1.5713788

Conduct LU decomposition on the matrix.

library(pracma)
luMat <- corDFT %*% corDF
lu(luMat, scheme = "ijk")
## $L
##             LotArea SalePrice GrLivArea
## LotArea   1.0000000 0.0000000         0
## SalePrice 0.6270724 1.0000000         0
## GrLivArea 0.6262478 0.9248161         1
## 
## $U
##            LotArea SalePrice GrLivArea
## LotArea   1.138843 0.7141373 0.7131982
## SalePrice 0.000000 1.1239462 1.0394435
## GrLivArea 0.000000 0.0000000 0.1634459

Calculus-Based Probability & Statistics

Many times, it makes sense to fit a closed form distribution to data. For the first variable that you selected which is skewed to the right, shift it so that the minimum value is above zero as necessary.

min(df$LotArea) # Above zero
## [1] 1300
lotVec <- df$LotArea - min(df$LotArea) + 0.0001
min(lotVec)
## [1] 1e-04

Then load the MASS package and run fitdistr to fit an exponential probability density function. (See https://stat.ethz.ch/R-manual/R- devel/library/MASS/html/fitdistr.html ).

library(MASS)

Find the optimal value of λ for this distribution, and then take 1000 samples from this exponential distribution using this value (e.g., rexp(1000, λ)).

fit <- fitdistr(lotVec, "exponential")
lambda <- fit$estimate
lambda
##         rate 
## 0.0001084972
samples <- rexp(1000, lambda)

Plot a histogram and compare it with a histogram of your original variable.

qplot(samples, main = 'Simulated') + theme_minimal()

qplot(lotVec, main = 'Observed') + theme_minimal()

Using the exponential pdf, find the 5th and 95th percentiles using the cumulative distribution function (CDF).

\[ CDF = \frac{ln(1 - P)}{-\lambda} \]

Also generate a 95% confidence interval from the empirical data, assuming normality. Finally, provide the empirical 5th percentile and 95th percentile of the data. Discuss.

cdf5 <- log(0.95)/ - lambda
cdf95 <- log(0.05)/ - lambda

obs5 <- quantile(lotVec, 0.05)
obs95 <- quantile(lotVec, 0.95)

x1 <- t.test(lotVec)$conf.int[1:2]

x <- data_frame(Type = c('Simulated', "Observed", "CI"), P5 = c(cdf5, obs5, x1[1]), P95 = c(cdf95, obs95, x1[2])) 
kable(x)
Type P5 P95
Simulated 472.7615 27611.150
Observed 2011.7001 16101.150
CI 8704.4181 9729.238

The exponential distroubution does not do a good job of estimating the actual variables. In this case, a boot straped CI would proabably be more effective. The Actual t-test of the mean doesn’t have much to do with the quantiles.

Modeling

Build some type of multiple regression model and submit your model to the competition board. Provide your complete model summary and results with analysis. Report your Kaggle.com user name and score.

Data cleaning:

cleaner <- function(df){
  numericNames <- df %>% select_if(is.numeric) %>% colnames()
  for (x in numericNames) {
     meanValue <- mean(df[[x]],na.rm = TRUE)
      df[[x]][is.na(df[[x]])] <- meanValue
  }
  # Skewed fix
  for (i in numericNames) {
    if (skewness(df[[i]]) > 0.75){
      df[[i]] = log(df[[i]] + 1)
    }
  }
  df[is.na(df)] <- 'Unknown'
  return(df)
}
trainDF <- read_csv('train.csv')
testDF <- read_csv('test.csv')
trainDF$IsTrain <- TRUE
testDF$IsTrain <- FALSE
SalePrice <- log(trainDF$SalePrice)
trainDF$SalePrice <- NULL
Id <- testDF$Id
aggDF <- rbind(trainDF, testDF)
aggDF$Id <- NULL
aggDF <- cleaner(aggDF)

aggDF[sapply(aggDF, is.character)] <- lapply(aggDF[sapply(aggDF, is.character)], as.factor)
aggDF[sapply(aggDF, is.factor)] <- lapply(aggDF[sapply(aggDF, is.factor)], as.numeric) # possible because of non-linear fitting

trainDF <- aggDF %>% filter(IsTrain == TRUE)  %>% dplyr::select(-IsTrain)
trainDF$SalePrice <- SalePrice
testDF <- aggDF %>% filter(IsTrain == FALSE) %>% dplyr::select(-IsTrain)
svmMod <- svm(SalePrice ~ ., data = trainDF, cost = 1)
preds = predict(svmMod, testDF)
submission = cbind(Id = Id, SalePrice = exp(preds))
colnames(submission) = c("Id","SalePrice")

write.csv(submission,file="svmKai.csv",row.names=FALSE)
# Kaggle Score: 0.16514
predsActual = predict(svmMod, trainDF)
qplot(x = exp(predsActual), 
      y =  exp(trainDF$SalePrice), 
      xlab = 'Actual Sale Price',
      ylab = 'Predicted Sale Price',
      main = 'Scatter Plot') + 
  theme_minimal()

train <- read.csv("train.csv")


linearMod <-lm(SalePrice ~ YearBuilt, data=train)


linPred <- predict(linearMod, train)
qplot(train$SalePrice, 
      linPred,
      xlab = 'Actual',
      ylab = 'Predicted',
      main = 'Scatter for Linear Regression') +
  theme_minimal()

# 0.33 on the training set.

We can see this looks very non-linear. This is why the SVM worked so much better.

max(abs(trainDF$SalePrice - predsActual))
## [1] 1.159648
diagnostic <- trainDF
diagnostic$Preds <- predsActual

diagnostic %>% 
  filter(abs(SalePrice - Preds) > 0.3 )