pacman::p_load(tidyverse,MASS,pscl,DataExplorer)
setwd("C:/Users/justi/OneDrive/Desktop/Grad School/UTSA 1st semester/STA 6443 Statistical Modeling/Final")
households <- read.csv("catalog.csv") Final Exam
Part 1: Definitions
EDA - Exploratory Data Analysis – The process of analyzing data done prior to running a model or serious analysis with the goal of getting to know your data. The EDA phase is meant to help you gain familiarity with your dataset, variables, and data types so that you are more prepared to draw insights from your analysis. The EDA phase is also used to formulate a question to center your analysis around. Useful functions for running EDA include: str(), glimpse(), head(), names(), cor(), and various scatterplots.
One-Way ANOVA versus Two-Way ANOVA – One way ANOVA is a way to assess if there is a difference in means accross a categorical variable. Typically, there is one numerical variables (i.e. price) and one categorical variable (i.e. Direction – N,W,E,S). Two-Way ANOVA is a larger scale statistical model used for assessing two categorical variables impact on a numerical variable such as: is sale price affected by direction and sqare-footage. The post-test results are significally longer when you run a two-way vs one-way ANOVA test due to the fact that more outcomes are being tested on.
The method of least squares for regression – The method of least squares is a way to find the line of best fit for a regression model. If you were to plot a graph to showed the relationship between x and y, least squares would help you determine the best fitted line going though your points with the least amount of residual error. This method is often used to minimize residual error in the process of trying find the line of best fit for your regression model.
Assumptions of a linear model and how to check them – The assumptions of linear model would be linearity, Homoscedasticity, and Normality of residuals. To check for linearity you would want to assess the relationship between x and y which can be done with a scatterplot and by drawing a regression line between the points. Next would be homscedasticity which is when the variance of the plotted points all move in a constant direction. This assumption exsists to ensure that the noise is constant in your data and not scattered. Lastly, is normality of residual. This is used to measure if your errors are consistent or not. Often tested by using a histogram or a QQ plot.
Part 2: Regression
Installed Packages:
To begin, I loaded the tidyverse, MASS, pscl, and DataExplorer packages and set the working directory to where my data was located. Lastly, I created a dataframe called housing_data to store the data. Next, I performed an exploratory data analysis on the housing data with the goal of being able to fit this data into regression models and predict housing prices using the variable SalePrice.
Data Cleaning:
Basic Summary - Taking a look at the variables
summary(households) SpendRat Age LenRes Income
Min. : 0.080 Min. : 0.00 Min. : 0.0 Min. :1.000
1st Qu.: 5.905 1st Qu.:42.00 1st Qu.: 8.0 1st Qu.:4.000
Median : 17.840 Median :52.00 Median :10.0 Median :5.000
Mean : 42.570 Mean :50.59 Mean :14.1 Mean :4.535
3rd Qu.: 46.708 3rd Qu.:61.00 3rd Qu.:18.0 3rd Qu.:5.000
Max. :401.420 Max. :89.00 Max. :46.0 Max. :9.000
TotAsset SecAssets ShortLiq LongLiq
Min. : 5.00 Min. : 0.00 Min. :160.0 Min. :400.0
1st Qu.: 97.25 1st Qu.: 19.00 1st Qu.:210.0 1st Qu.:420.0
Median :150.00 Median : 28.00 Median :230.0 Median :430.0
Mean :185.46 Mean : 40.72 Mean :239.9 Mean :439.4
3rd Qu.:225.00 3rd Qu.: 42.25 3rd Qu.:260.0 3rd Qu.:440.0
Max. :999.00 Max. :999.00 Max. :999.0 Max. :999.0
WlthIdx SpendVol SpenVel CollGifts BricMortar
Min. : 90.0 Min. : 0.0 Min. : 0.0 Min. :0.00 Min. :0.000
1st Qu.:300.0 1st Qu.:524.5 1st Qu.: 47.5 1st Qu.:0.00 1st Qu.:0.000
Median :360.0 Median :610.0 Median :170.0 Median :0.00 Median :0.000
Mean :366.1 Mean :565.5 Mean :219.7 Mean :0.48 Mean :0.285
3rd Qu.:422.5 3rd Qu.:670.0 3rd Qu.:308.5 3rd Qu.:1.00 3rd Qu.:1.000
Max. :880.0 Max. :780.0 Max. :999.0 Max. :1.00 Max. :1.000
MarthaHome SunAds ThemeColl CustDec RetailKids
Min. :0.000 Min. :0.00 Min. :0.00 Min. :0.00 Min. :0.00
1st Qu.:0.000 1st Qu.:0.00 1st Qu.:0.00 1st Qu.:0.00 1st Qu.:0.00
Median :0.000 Median :0.00 Median :0.00 Median :0.00 Median :0.00
Mean :0.355 Mean :0.43 Mean :0.38 Mean :0.36 Mean :0.35
3rd Qu.:1.000 3rd Qu.:1.00 3rd Qu.:1.00 3rd Qu.:1.00 3rd Qu.:1.00
Max. :1.000 Max. :1.00 Max. :1.00 Max. :1.00 Max. :1.00
TeenWr Carlovers CountryColl
Min. :0.0 Min. :0.000 Min. :0.00
1st Qu.:0.0 1st Qu.:0.000 1st Qu.:0.00
Median :0.5 Median :0.000 Median :0.00
Mean :0.5 Mean :0.265 Mean :0.42
3rd Qu.:1.0 3rd Qu.:1.000 3rd Qu.:1.00
Max. :1.0 Max. :1.000 Max. :1.00 This basic summary gives a look inside of each of the variables that are within this dataset. I will focus mainly on the age, length of residence, spending ratio, spending volume, total assets, wealth index, and spendvel. The reason for focusing mostly on the spending variables is because these are good indicators of spending habits of the people within this dataset.
households |> arrange(Age, desc(Age)) |> head(20) SpendRat Age LenRes Income TotAsset SecAssets ShortLiq LongLiq WlthIdx
1 11.83 0 2 3 122 27 225 422 286
2 31.67 0 8 6 243 55 220 450 370
3 3.35 0 2 6 112 26 310 440 400
4 2.31 0 2 5 132 28 227 424 303
5 47.18 0 8 4 397 75 240 480 430
6 6.76 0 4 7 258 50 230 470 410
7 46.08 0 2 5 130 25 220 423 297
8 9.80 0 5 5 81 16 194 411 230
9 9.58 0 4 6 170 33 270 440 410
10 31.65 0 9 6 92 21 240 430 320
11 1.00 0 8 6 240 37 200 420 380
12 8.50 0 9 7 139 19 210 400 390
13 4.56 0 9 6 63 15 220 430 270
14 1.11 0 9 6 187 43 200 420 320
15 230.89 20 21 5 564 109 250 520 490
16 77.21 21 3 4 206 12 280 460 420
17 7.60 30 7 4 20 1 220 400 200
18 8.82 31 10 4 133 23 222 420 298
19 9.92 31 35 1 181 39 242 438 363
20 33.15 32 3 5 32 2 220 410 260
SpendVol SpenVel CollGifts BricMortar MarthaHome SunAds ThemeColl CustDec
1 503 285 1 0 0 1 0 1
2 580 170 0 0 0 0 0 0
3 0 0 0 0 0 0 0 0
4 534 281 0 0 0 1 0 0
5 630 260 0 1 1 0 0 1
6 580 230 1 0 0 0 1 0
7 547 300 0 0 0 0 0 0
8 541 329 0 1 1 0 0 1
9 650 60 1 0 0 1 0 1
10 410 30 0 1 0 0 0 1
11 680 410 1 0 0 1 0 0
12 710 600 0 0 0 0 1 1
13 260 0 0 0 1 1 0 1
14 670 270 0 0 0 0 0 0
15 700 130 1 1 1 1 1 1
16 690 20 1 1 0 0 0 0
17 560 10 0 1 0 0 0 0
18 584 334 0 0 0 0 0 0
19 520 194 1 0 0 1 0 0
20 590 310 0 0 0 0 0 0
RetailKids TeenWr Carlovers CountryColl
1 1 1 0 1
2 0 0 0 0
3 0 1 0 0
4 0 0 0 0
5 0 1 0 1
6 0 0 0 1
7 0 0 1 0
8 0 0 0 0
9 1 0 0 1
10 1 1 0 0
11 0 0 0 1
12 0 0 0 0
13 1 0 0 0
14 0 0 0 0
15 0 1 0 1
16 0 1 1 1
17 0 1 1 0
18 1 0 0 0
19 1 0 1 1
20 0 1 0 0The first step I took in cleaning out the dataset was to filter the Age variable in DESC order while also including the LenRes column. This revealed that there were 14 values containing people who had an age of 0 and length of residence that was higher than their age. I then removed these invalid data points to improve the accuracy of the data. Additionally, I used the code above to scroll through all 200 observations of the dataset to ensure that the length of residence was never higher than a persons ago. The reason for arranging the age in descending order was to be able to line the length of residence up with it side by side to see if there were any outliers that needed to be removed. The values would need to be removed because a person cannot be 0 and have a length of residence of 5 years simultaneously.
households = households |> filter(Age >= 18)Next, I notced there were about 15 outliers in spending ratio over 150% and I decided to clear these out
households = households |> filter(SpendRat < 150) Another step in cleaning the data I want to highlight is Total Assets. The mean is 186 and the max is 999. There are values as large as 1000 that deviate from the typical range of 150 - 550. I will remove these outliers because I suspect that these are typos within the dataset and could skew results.
households = households |> filter(TotAsset < 600)households |> arrange(SpendVol, desc(SpendVol)) |> head(20) SpendRat Age LenRes Income TotAsset SecAssets ShortLiq LongLiq WlthIdx
1 0.26 89 11 5 57 13 230 420 280
2 22.44 78 40 4 38 9 210 420 230
3 32.50 57 46 3 79 18 240 430 310
4 13.50 62 14 2 77 18 260 430 330
5 0.08 78 9 2 65 15 250 430 300
6 36.53 52 35 3 48 9 220 420 250
7 45.50 76 17 3 44 10 200 420 220
8 0.71 86 42 2 90 21 280 440 360
9 5.86 66 8 4 81 19 250 430 320
10 3.18 53 30 5 89 17 270 440 350
11 8.39 84 22 2 91 21 260 440 340
12 8.29 73 3 4 73 17 250 430 310
13 19.20 46 27 4 52 12 210 420 250
14 23.08 74 25 3 84 19 260 430 330
15 0.77 71 9 5 43 10 200 420 210
16 19.48 63 7 5 95 22 270 440 360
17 129.72 40 9 2 58 9 270 420 320
18 1.83 78 26 7 5 0 180 400 90
19 14.50 68 35 2 94 22 270 440 360
20 44.13 87 2 1 48 21 178 419 198
SpendVol SpenVel CollGifts BricMortar MarthaHome SunAds ThemeColl CustDec
1 0 0 0 0 0 0 0 0
2 0 0 0 1 0 0 0 0
3 0 0 0 0 0 0 0 0
4 80 0 1 0 1 1 1 0
5 80 0 0 0 0 0 0 0
6 130 0 0 0 0 1 1 0
7 170 0 0 1 1 0 0 0
8 180 10 0 0 0 0 0 0
9 220 0 0 0 1 1 0 1
10 230 0 0 0 1 0 0 0
11 240 0 1 0 0 1 1 0
12 250 0 0 0 0 1 1 0
13 260 10 1 0 0 1 1 0
14 260 0 0 1 0 0 0 0
15 300 10 0 0 0 0 1 0
16 340 30 1 0 1 1 1 1
17 350 30 1 1 1 0 0 1
18 350 630 0 0 0 0 0 0
19 360 40 1 0 1 1 0 0
20 362 205 1 0 0 1 0 0
RetailKids TeenWr Carlovers CountryColl
1 0 0 0 0
2 0 0 0 0
3 0 0 0 0
4 0 0 0 1
5 0 0 0 0
6 0 0 1 1
7 0 0 0 1
8 0 1 0 0
9 1 0 0 0
10 0 1 0 0
11 0 0 0 1
12 0 1 0 1
13 1 0 1 1
14 0 0 0 0
15 0 1 0 0
16 1 0 0 1
17 1 0 0 0
18 0 0 0 0
19 0 0 0 1
20 0 0 0 1How can someone have 0 spending volume and still make an income? You have to eat at some point! I will remove these outliers
households = households |> filter(SpendVol > 80)Upon making these edits we are now left with 165 observations in the dataset
EDA:
plot_histogram(households)
plot_bar(households)
SpendRat This variables graph shows that the spending ratio among the people that are being observed is very right skewed. This indicates that a majority of the people in the dataset have a low to medium spending ratio, indicating that people within this dataset are fiscally responsible. (Assuming that spending ratio is an indicator of how much a person spends of their assets relative to their liabilities.)
Spending Volume: This left-skewed graph indicates that people within this dataset are high volume spenders with a major spike in the data in the 450-700 range. This could indicate that people within this dataset are spending at high to medium volumes.
Spending Velocity Something interesting to takeaway from these graphs is that these spending variables are incredibly skewed. In graph 1 we have a majority of low spending ratios, in graph 2 we have a lot of high volume spenders, and in graph 3 we have lower velocity spenders. This indicates that we have a specific type of group of people in this dataset: Fiscally responsible, high volume, yet steady, spenders.
Age: Next, looking at age you can see that the range of ages most commonly seen in this dataset is between 40 - 60 years old with the mean being right at 54 years of age. Taking into consideration that this data is being run mostly on middle aged people with the exception of outliers.
households |> ggplot(aes(x = TotAsset, y = WlthIdx)) +
geom_point(size = 3, color = "#0D47A1") +
labs(
title = "Total Assets to Wealth Index",
x = "Total Assets",
y = "Wealth Index"
) +
theme_minimal(base_size = 14)
cor(households$WlthIdx, households$TotAsset)[1] 0.8193917Graph 5: Excellent! I found correlation and possible linearity.
households |> ggplot(aes(x = TotAsset, y = SecAssets)) +
geom_point(size = 3, color = "#0D47A1") +
labs(
title = "Total Assets to Secondary Assets",
x = "Total Assets",
y = "Secondary Assets"
) +
theme_minimal(base_size = 14)
Graph 6 More linearity betweeen these two
plot_correlation(households)
–
Modeling:
pairs(households)
pairs(households)2. Building the Model
multiple_reg <- lm(SpendRat ~ ., data = households)
summary(multiple_reg)
Call:
lm(formula = SpendRat ~ ., data = households)
Residuals:
Min 1Q Median 3Q Max
-61.459 -15.916 -5.081 14.950 95.865
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) -45.334073 102.407123 -0.443 0.658658
Age 0.171609 0.217106 0.790 0.430570
LenRes 0.327409 0.256213 1.278 0.203348
Income -1.161769 1.720701 -0.675 0.500649
TotAsset -0.106192 0.087445 -1.214 0.226587
SecAssets 0.156249 0.366294 0.427 0.670333
ShortLiq 0.188756 0.163203 1.157 0.249363
LongLiq -0.012549 0.262471 -0.048 0.961934
WlthIdx -0.072833 0.092561 -0.787 0.432658
SpendVol 0.062207 0.028970 2.147 0.033447 *
SpenVel 0.004206 0.017192 0.245 0.807071
CollGifts 17.260825 5.702777 3.027 0.002929 **
BricMortar 20.537588 5.612120 3.660 0.000354 ***
MarthaHome 18.198847 5.417949 3.359 0.001001 **
SunAds 2.254379 6.453994 0.349 0.727374
ThemeColl 14.178523 5.136736 2.760 0.006528 **
CustDec 5.850683 5.955648 0.982 0.327563
RetailKids -5.798482 5.832484 -0.994 0.321808
TeenWr 5.016002 4.712845 1.064 0.288963
Carlovers 11.848232 5.055076 2.344 0.020454 *
CountryColl -6.781700 6.775019 -1.001 0.318513
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 27.4 on 144 degrees of freedom
Multiple R-squared: 0.3773, Adjusted R-squared: 0.2908
F-statistic: 4.363 on 20 and 144 DF, p-value: 7.766e-08Takeaway So far, with SpendRat as the response variable the predictor variables that are statistically significant are: SpendVol (0.033447), CollGifts (0.002929), BricMortar (0.000354), MarthHome (0.001001), and ThemeColl (0.006528). With an adjusted R^2 of .2908 we can see that the model explains 29% of the variation in SpendRat. Also, with an F stat of 7.766e-08 we can see that some of the results are statistically significant.
The age coefficient of 0.17 tells us for every one unit increase in age spending ratio increases by .17. It tells us that older individuals tend to have higher spending ratios.
3. Stepwise Selection
step_wise <- stepAIC(
multiple_reg,
direction = "both",
trace = TRUE)Start: AIC=1112
SpendRat ~ Age + LenRes + Income + TotAsset + SecAssets + ShortLiq +
LongLiq + WlthIdx + SpendVol + SpenVel + CollGifts + BricMortar +
MarthaHome + SunAds + ThemeColl + CustDec + RetailKids +
TeenWr + Carlovers + CountryColl
Df Sum of Sq RSS AIC
- LongLiq 1 1.7 108101 1110.0
- SpenVel 1 44.9 108144 1110.1
- SunAds 1 91.6 108191 1110.1
- SecAssets 1 136.6 108236 1110.2
- Income 1 342.2 108441 1110.5
- WlthIdx 1 464.8 108564 1110.7
- Age 1 469.0 108568 1110.7
- CustDec 1 724.5 108823 1111.1
- RetailKids 1 742.0 108841 1111.1
- CountryColl 1 752.2 108851 1111.2
- TeenWr 1 850.4 108949 1111.3
- ShortLiq 1 1004.2 109103 1111.5
- TotAsset 1 1107.1 109206 1111.7
- LenRes 1 1225.9 109325 1111.9
<none> 108099 1112.0
- SpendVol 1 3461.2 111560 1115.2
- Carlovers 1 4123.9 112223 1116.2
- ThemeColl 1 5719.3 113818 1118.5
- CollGifts 1 6877.2 114976 1120.2
- MarthaHome 1 8469.9 116569 1122.5
- BricMortar 1 10053.2 118152 1124.7
Step: AIC=1110
SpendRat ~ Age + LenRes + Income + TotAsset + SecAssets + ShortLiq +
WlthIdx + SpendVol + SpenVel + CollGifts + BricMortar + MarthaHome +
SunAds + ThemeColl + CustDec + RetailKids + TeenWr + Carlovers +
CountryColl
Df Sum of Sq RSS AIC
- SpenVel 1 55.9 108157 1108.1
- SunAds 1 95.0 108196 1108.2
- SecAssets 1 146.5 108247 1108.2
- Income 1 345.6 108446 1108.5
- Age 1 469.9 108570 1108.7
- WlthIdx 1 484.5 108585 1108.7
- CustDec 1 723.5 108824 1109.1
- RetailKids 1 743.7 108844 1109.1
- CountryColl 1 767.0 108868 1109.2
- TeenWr 1 852.3 108953 1109.3
- ShortLiq 1 1182.5 109283 1109.8
- TotAsset 1 1219.5 109320 1109.8
- LenRes 1 1238.9 109340 1109.9
<none> 108101 1110.0
+ LongLiq 1 1.7 108099 1112.0
- SpendVol 1 3487.0 111588 1113.2
- Carlovers 1 4194.4 112295 1114.3
- ThemeColl 1 5725.4 113826 1116.5
- CollGifts 1 6875.5 114976 1118.2
- MarthaHome 1 8498.7 116599 1120.5
- BricMortar 1 10260.7 118361 1123.0
Step: AIC=1108.09
SpendRat ~ Age + LenRes + Income + TotAsset + SecAssets + ShortLiq +
WlthIdx + SpendVol + CollGifts + BricMortar + MarthaHome +
SunAds + ThemeColl + CustDec + RetailKids + TeenWr + Carlovers +
CountryColl
Df Sum of Sq RSS AIC
- SunAds 1 97.5 108254 1106.2
- SecAssets 1 176.7 108333 1106.4
- Income 1 314.8 108471 1106.6
- Age 1 448.3 108605 1106.8
- WlthIdx 1 460.6 108617 1106.8
- CustDec 1 685.9 108842 1107.1
- RetailKids 1 729.4 108886 1107.2
- CountryColl 1 784.3 108941 1107.3
- TeenWr 1 828.0 108985 1107.3
- LenRes 1 1248.2 109405 1108.0
<none> 108157 1108.1
- TotAsset 1 1555.6 109712 1108.5
- ShortLiq 1 1758.7 109915 1108.8
+ SpenVel 1 55.9 108101 1110.0
+ LongLiq 1 12.7 108144 1110.1
- SpendVol 1 3540.7 111697 1111.4
- Carlovers 1 4146.3 112303 1112.3
- ThemeColl 1 5769.0 113925 1114.7
- CollGifts 1 6825.0 114982 1116.2
- MarthaHome 1 8668.2 116825 1118.8
- BricMortar 1 10306.4 118463 1121.1
Step: AIC=1106.24
SpendRat ~ Age + LenRes + Income + TotAsset + SecAssets + ShortLiq +
WlthIdx + SpendVol + CollGifts + BricMortar + MarthaHome +
ThemeColl + CustDec + RetailKids + TeenWr + Carlovers + CountryColl
Df Sum of Sq RSS AIC
- SecAssets 1 174.9 108429 1104.5
- Income 1 308.1 108562 1104.7
- WlthIdx 1 460.6 108715 1104.9
- Age 1 529.9 108784 1105.0
- RetailKids 1 635.8 108890 1105.2
- CountryColl 1 709.5 108964 1105.3
- CustDec 1 789.2 109043 1105.4
- TeenWr 1 803.3 109057 1105.5
- LenRes 1 1249.0 109503 1106.1
<none> 108254 1106.2
- TotAsset 1 1565.1 109819 1106.6
- ShortLiq 1 1826.0 110080 1107.0
+ SunAds 1 97.5 108157 1108.1
+ SpenVel 1 58.4 108196 1108.2
+ LongLiq 1 20.4 108234 1108.2
- SpendVol 1 3539.9 111794 1109.5
- Carlovers 1 4473.6 112728 1110.9
- ThemeColl 1 6058.3 114312 1113.2
- CollGifts 1 6753.4 115007 1114.2
- MarthaHome 1 8589.0 116843 1116.8
- BricMortar 1 10397.8 118652 1119.4
Step: AIC=1104.5
SpendRat ~ Age + LenRes + Income + TotAsset + ShortLiq + WlthIdx +
SpendVol + CollGifts + BricMortar + MarthaHome + ThemeColl +
CustDec + RetailKids + TeenWr + Carlovers + CountryColl
Df Sum of Sq RSS AIC
- Income 1 340.2 108769 1103.0
- WlthIdx 1 453.5 108882 1103.2
- CountryColl 1 631.3 109060 1103.5
- TeenWr 1 802.6 109232 1103.7
- RetailKids 1 820.4 109249 1103.8
- Age 1 859.0 109288 1103.8
- CustDec 1 935.7 109365 1103.9
- LenRes 1 1248.5 109677 1104.4
<none> 108429 1104.5
- ShortLiq 1 1871.4 110300 1105.3
+ SecAssets 1 174.9 108254 1106.2
+ SunAds 1 95.7 108333 1106.4
+ SpenVel 1 88.9 108340 1106.4
+ LongLiq 1 0.0 108429 1106.5
- TotAsset 1 2688.7 111118 1106.5
- SpendVol 1 3411.9 111841 1107.6
- Carlovers 1 4562.2 112991 1109.3
- ThemeColl 1 5899.0 114328 1111.2
- CollGifts 1 6714.3 115143 1112.4
- MarthaHome 1 8675.0 117104 1115.2
- BricMortar 1 10254.9 118684 1117.4
Step: AIC=1103.02
SpendRat ~ Age + LenRes + TotAsset + ShortLiq + WlthIdx + SpendVol +
CollGifts + BricMortar + MarthaHome + ThemeColl + CustDec +
RetailKids + TeenWr + Carlovers + CountryColl
Df Sum of Sq RSS AIC
- WlthIdx 1 428.1 109197 1101.7
- CountryColl 1 473.7 109243 1101.7
- TeenWr 1 738.8 109508 1102.1
- Age 1 791.2 109560 1102.2
- CustDec 1 832.5 109602 1102.3
- RetailKids 1 907.4 109677 1102.4
<none> 108769 1103.0
- LenRes 1 1442.3 110211 1103.2
- ShortLiq 1 1800.6 110570 1103.7
+ Income 1 340.2 108429 1104.5
+ SecAssets 1 207.0 108562 1104.7
+ SunAds 1 88.6 108680 1104.9
+ SpenVel 1 49.6 108720 1105.0
+ LongLiq 1 0.2 108769 1105.0
- TotAsset 1 2809.4 111578 1105.2
- SpendVol 1 3216.6 111986 1105.8
- Carlovers 1 4427.1 113196 1107.6
- ThemeColl 1 5713.4 114483 1109.5
- CollGifts 1 6443.0 115212 1110.5
- MarthaHome 1 8449.2 117218 1113.4
- BricMortar 1 10040.4 118810 1115.6
Step: AIC=1101.67
SpendRat ~ Age + LenRes + TotAsset + ShortLiq + SpendVol + CollGifts +
BricMortar + MarthaHome + ThemeColl + CustDec + RetailKids +
TeenWr + Carlovers + CountryColl
Df Sum of Sq RSS AIC
- CountryColl 1 579.6 109777 1100.5
- Age 1 769.8 109967 1100.8
- TeenWr 1 791.0 109988 1100.9
- CustDec 1 995.0 110192 1101.2
- RetailKids 1 1153.2 110350 1101.4
- LenRes 1 1261.7 110459 1101.6
<none> 109197 1101.7
- ShortLiq 1 1580.7 110778 1102.0
+ WlthIdx 1 428.1 108769 1103.0
+ Income 1 314.8 108882 1103.2
+ SecAssets 1 198.2 108999 1103.4
+ LongLiq 1 89.2 109108 1103.5
+ SunAds 1 89.0 109108 1103.5
+ SpenVel 1 29.0 109168 1103.6
- SpendVol 1 2794.4 111992 1103.8
- Carlovers 1 4258.1 113455 1106.0
- ThemeColl 1 5461.8 114659 1107.7
- CollGifts 1 6746.0 115943 1109.6
- TotAsset 1 7527.5 116725 1110.7
- MarthaHome 1 8060.8 117258 1111.4
- BricMortar 1 9912.0 119109 1114.0
Step: AIC=1100.54
SpendRat ~ Age + LenRes + TotAsset + ShortLiq + SpendVol + CollGifts +
BricMortar + MarthaHome + ThemeColl + CustDec + RetailKids +
TeenWr + Carlovers
Df Sum of Sq RSS AIC
- Age 1 720.8 110498 1099.6
- TeenWr 1 897.1 110674 1099.9
- CustDec 1 946.6 110723 1100.0
- RetailKids 1 1073.7 110851 1100.2
- LenRes 1 1202.9 110980 1100.3
<none> 109777 1100.5
- ShortLiq 1 1590.8 111368 1100.9
+ CountryColl 1 579.6 109197 1101.7
+ WlthIdx 1 534.0 109243 1101.7
+ Income 1 149.5 109627 1102.3
+ SecAssets 1 107.0 109670 1102.4
+ LongLiq 1 65.3 109712 1102.4
+ SpenVel 1 34.8 109742 1102.5
+ SunAds 1 17.4 109759 1102.5
- SpendVol 1 2987.5 112764 1103.0
- Carlovers 1 4463.4 114240 1105.1
- ThemeColl 1 4894.3 114671 1105.7
- CollGifts 1 6583.7 116361 1108.2
- TotAsset 1 7299.4 117076 1109.2
- MarthaHome 1 8822.2 118599 1111.3
- BricMortar 1 9506.1 119283 1112.2
Step: AIC=1099.62
SpendRat ~ LenRes + TotAsset + ShortLiq + SpendVol + CollGifts +
BricMortar + MarthaHome + ThemeColl + CustDec + RetailKids +
TeenWr + Carlovers
Df Sum of Sq RSS AIC
- TeenWr 1 729.7 111227 1098.7
- CustDec 1 1087.5 111585 1099.2
<none> 110498 1099.6
- ShortLiq 1 1373.2 111871 1099.7
- RetailKids 1 1666.6 112164 1100.1
- LenRes 1 1675.9 112174 1100.1
+ Age 1 720.8 109777 1100.5
+ CountryColl 1 530.6 109967 1100.8
+ WlthIdx 1 506.1 109992 1100.9
- SpendVol 1 2282.0 112780 1101.0
+ SecAssets 1 355.7 110142 1101.1
+ LongLiq 1 190.2 110307 1101.3
+ Income 1 113.8 110384 1101.5
+ SpenVel 1 36.0 110462 1101.6
+ SunAds 1 0.1 110498 1101.6
- Carlovers 1 4131.6 114629 1103.7
- ThemeColl 1 4791.4 115289 1104.6
- TotAsset 1 6636.3 117134 1107.2
- CollGifts 1 6952.4 117450 1107.7
- MarthaHome 1 8764.8 119262 1110.2
- BricMortar 1 9327.3 119825 1111.0
Step: AIC=1098.71
SpendRat ~ LenRes + TotAsset + ShortLiq + SpendVol + CollGifts +
BricMortar + MarthaHome + ThemeColl + CustDec + RetailKids +
Carlovers
Df Sum of Sq RSS AIC
- CustDec 1 826.7 112054 1097.9
<none> 111227 1098.7
- RetailKids 1 1474.1 112701 1098.9
- ShortLiq 1 1544.7 112772 1099.0
- LenRes 1 1722.9 112950 1099.2
+ TeenWr 1 729.7 110498 1099.6
+ CountryColl 1 628.0 110599 1099.8
+ WlthIdx 1 573.2 110654 1099.9
+ Age 1 553.4 110674 1099.9
+ SecAssets 1 300.4 110927 1100.3
+ LongLiq 1 266.1 110961 1100.3
+ Income 1 74.2 111153 1100.6
+ SpenVel 1 63.1 111164 1100.6
+ SunAds 1 5.3 111222 1100.7
- SpendVol 1 2742.2 113970 1100.7
- Carlovers 1 4291.4 115519 1103.0
- ThemeColl 1 5387.2 116615 1104.5
- TotAsset 1 6903.0 118130 1106.6
- CollGifts 1 6950.8 118178 1106.7
- MarthaHome 1 9053.8 120281 1109.6
- BricMortar 1 11866.1 123094 1113.4
Step: AIC=1097.93
SpendRat ~ LenRes + TotAsset + ShortLiq + SpendVol + CollGifts +
BricMortar + MarthaHome + ThemeColl + RetailKids + Carlovers
Df Sum of Sq RSS AIC
- RetailKids 1 847.3 112901 1097.2
<none> 112054 1097.9
- LenRes 1 1715.4 113769 1098.4
+ CustDec 1 826.7 111227 1098.7
+ WlthIdx 1 721.0 111333 1098.9
+ Age 1 689.7 111364 1098.9
- ShortLiq 1 2107.1 114161 1099.0
+ CountryColl 1 556.5 111498 1099.1
+ SecAssets 1 498.9 111555 1099.2
+ TeenWr 1 468.9 111585 1099.2
+ LongLiq 1 454.4 111600 1099.3
+ SpenVel 1 131.4 111923 1099.7
+ Income 1 35.7 112018 1099.9
+ SunAds 1 9.3 112045 1099.9
- SpendVol 1 2997.1 115051 1100.3
- Carlovers 1 4355.8 116410 1102.2
- ThemeColl 1 5868.9 117923 1104.3
- CollGifts 1 7131.1 119185 1106.1
- TotAsset 1 7180.4 119234 1106.2
- BricMortar 1 11716.1 123770 1112.3
- MarthaHome 1 12456.2 124510 1113.3
Step: AIC=1097.17
SpendRat ~ LenRes + TotAsset + ShortLiq + SpendVol + CollGifts +
BricMortar + MarthaHome + ThemeColl + Carlovers
Df Sum of Sq RSS AIC
<none> 112901 1097.2
- LenRes 1 1512.1 114413 1097.4
+ Age 1 1059.2 111842 1097.6
+ WlthIdx 1 907.9 111993 1097.8
+ RetailKids 1 847.3 112054 1097.9
+ SecAssets 1 832.7 112069 1098.0
+ LongLiq 1 637.9 112263 1098.2
+ CountryColl 1 482.5 112419 1098.5
- ShortLiq 1 2277.1 115178 1098.5
+ TeenWr 1 435.5 112466 1098.5
+ CustDec 1 199.9 112701 1098.9
+ SpenVel 1 174.8 112727 1098.9
+ Income 1 90.4 112811 1099.0
+ SunAds 1 31.6 112870 1099.1
- SpendVol 1 2854.9 115756 1099.3
- Carlovers 1 4116.6 117018 1101.1
- ThemeColl 1 5898.8 118800 1103.6
- CollGifts 1 6387.3 119289 1104.2
- TotAsset 1 7166.5 120068 1105.3
- BricMortar 1 11556.4 124458 1111.2
- MarthaHome 1 12122.8 125024 1112.0summary(step_wise)
Call:
lm(formula = SpendRat ~ LenRes + TotAsset + ShortLiq + SpendVol +
CollGifts + BricMortar + MarthaHome + ThemeColl + Carlovers,
data = households)
Residuals:
Min 1Q Median 3Q Max
-58.000 -18.738 -4.282 14.480 93.637
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) -39.39993 20.52512 -1.920 0.056746 .
LenRes 0.34450 0.23910 1.441 0.151662
TotAsset -0.10016 0.03193 -3.137 0.002045 **
ShortLiq 0.11862 0.06709 1.768 0.079010 .
SpendVol 0.04522 0.02284 1.980 0.049504 *
CollGifts 13.70627 4.62855 2.961 0.003546 **
BricMortar 20.07915 5.04100 3.983 0.000104 ***
MarthaHome 19.76509 4.84485 4.080 7.2e-05 ***
ThemeColl 13.30486 4.67534 2.846 0.005030 **
Carlovers 11.38914 4.79076 2.377 0.018659 *
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 26.99 on 155 degrees of freedom
Multiple R-squared: 0.3496, Adjusted R-squared: 0.3119
F-statistic: 9.259 on 9 and 155 DF, p-value: 3.541e-11Takeaway This new model now goes from a .29 R squared to a .31 R squared showing that this new model does a better job predicting Spending Ratio. Also, this new model has 7 out of 9 statistically signifcant variables meaning it has a better predictive power than the first model.
4. Diagnostics Plots
par(mfrow = c(2, 2))
plot(step_wise)
The first time I ran this, I notice the QQ plot had a severe curve at the end of the line. I cleaned out the dataset further by removing 14 outliers of Spending ratio and that seemed to do the trick. I will note this in my conclusion.
- Trying out different models
households_log <- households |>
dplyr::mutate(log_Spend_Rat = log(SpendRat)) |>
dplyr::select(log_Spend_Rat, TotAsset, ShortLiq, SpendVol,
CollGifts, BricMortar, MarthaHome, ThemeColl, Carlovers)log_model <- lm(log_Spend_Rat ~ ., data = households_log)
summary(log_model)
Call:
lm(formula = log_Spend_Rat ~ ., data = households_log)
Residuals:
Min 1Q Median 3Q Max
-3.6723 -0.6149 0.0798 0.8569 2.4205
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 1.2565054 0.8129139 1.546 0.124208
TotAsset -0.0016645 0.0013234 -1.258 0.210356
ShortLiq -0.0003680 0.0028055 -0.131 0.895811
SpendVol 0.0012326 0.0009073 1.359 0.176238
CollGifts 0.6644277 0.1935967 3.432 0.000767 ***
BricMortar 0.8631332 0.2106050 4.098 6.67e-05 ***
MarthaHome 0.7785106 0.2015323 3.863 0.000164 ***
ThemeColl 0.4021340 0.1948730 2.064 0.040715 *
Carlovers 0.4725969 0.1994808 2.369 0.019054 *
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 1.129 on 156 degrees of freedom
Multiple R-squared: 0.3139, Adjusted R-squared: 0.2787
F-statistic: 8.922 on 8 and 156 DF, p-value: 4.96e-10par(mfrow = c(2, 2))
plot(log_model)
Takeaway: The best model is the second one titled step_wise with an Adj R^2 of 31% and the best set of statistically significant predictor variables. I tried a fourth model using X^2 and this model was unsuccessful.
6. Conclusion:
Top spenders score higher in these categories: TotAsset, SpendVol, CollGifts, BricMortar, MarthaHome, ThemeColl, Carlovers. Showing that people with more money typically buy nicer things.
The step_wise model explains 35% of spending behavior
Part 3: Classification
To begin I read in the data and properly named its headers:
adult <- read_csv(
"adult.data",
na = "?",
col_names = FALSE
)
adult <- adult |>
setNames(c(
"age", "workclass", "fnlwgt", "education", "education_num",
"marital_status", "occupation", "relationship", "race", "sex",
"capital_gain", "capital_loss", "hours_per_week", "native_country",
"income"
)) |>
dplyr::select(-fnlwgt) |>
mutate(income = factor(income, levels = c("<=50K", ">50K")))EDA:
plot_bar(adult)
plot_histogram(adult)
plot_boxplot(adult, by = "income")
Takeaway: My main takeaway from these graphs is that age, education_num, and hours_per_week seem to be some of the best predictors for predicting income. According to the plots, people who are on the higher end of the scale tend to have higher income levels. This will be useful when running the model because these will be the variables I use.
logistic <- glm(formula = income ~ age + education_num + hours_per_week,
data = adult,
family = binomial)
summary(logistic)
Call:
glm(formula = income ~ age + education_num + hours_per_week,
family = binomial, data = adult)
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -8.523161 0.110169 -77.36 <2e-16 ***
age 0.046911 0.001160 40.45 <2e-16 ***
education_num 0.345334 0.006480 53.29 <2e-16 ***
hours_per_week 0.042834 0.001268 33.78 <2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 35948 on 32560 degrees of freedom
Residual deviance: 28991 on 32557 degrees of freedom
AIC: 28999
Number of Fisher Scoring iterations: 5exp(.047)[1] 1.048122exp(0.345)[1] 1.41199exp(0.043)[1] 1.043938Since all of the predictors in this model are highly significant I have exponentiation their variables to get the log odds.
To find the R^2
pR2(logistic)fitting null model for pseudo-r2 llh llhNull G2 McFadden r2ML
-1.449534e+04 -1.797404e+04 6.957392e+03 1.935400e-01 1.923872e-01
r2CU
2.878044e-01 par(mfrow = c(2, 2))
plot(logistic)
Takeaways: The R^2 for this model is .1936~
In this problem, you will develop a model to predict whether income exceeds $50K/yr based on census data.2
Conclusion: Based off of this models log odds we can takeaway the following from this model.
As a person ages by 1 year their odds of earning a higher income increase by 4.8%
As a person increases their education level by year their odds of earning a higher income increase by 41%
As a person increases their hours worked per week by 1 hour their odds of earning more increase by 4.4%