Dimension Reduction - House Sales in King County
Pola Parol
2023-02-07
Introduction
I decided to explore “House Sales in King County” database. Database consists of a lot of variables which difference each house of sale. We can expect that the most variable is price, location and the square footage. Let’s see which factors make the most difference between selling homes in King Country using dimension reduction methods. As the result this project helps to get better understanding of the data and dependencies between variables.
Dataset
This dataset contains house sale prices for King County, which includes Seattle. It comprises homes sold between May 2014 and May 2015. At the beginning I deleted columns such as ID, Date, Zip Code and others variables which were very unique and rare. Next, I randomly chose 500 observations and randomized them, as their scale was different.
The data comes from ‘https://raw.githubusercontent.com/rashida048/Datasets/master/home_data.csv’.
Additionally, more information about dataset I got to know from:
Reading data
home <- read.table('home_data.txt', header = TRUE, sep = ',')
home = subset(home, select = -c(1,2,9,10,13,14,16,17,20,21))
nrow(home)## [1] 21613sum(is.na(home)) ## [1] 0set.seed(200)
home_sample1 <- home[sample(nrow(home), 500), ]
home_sample <- as.data.frame(scale(home_sample1))
home_map <- home_sample1[,c('lat','long')]The data relate to the price of houses and their characteristics, such as:
- price: Price is prediction target
- bedrooms: Number of Bedrooms/House
- bathrooms: Number of bathrooms/bedrooms
- sqft_living: Square footage of the home
- sqft_lot: Square footage of the lot
- floors: Total floors (levels) in house
- condition: How good the condition is Overall
- grade: Overall grade given to the housing unit, based on King County grading system
- yr_built: Built Year
- lat: Latitude coordinate
- long: Longitude coordinate
At first glance, each of the variables should have a significant impact on the price of the house.
Visualisation map
To have a better visualisation, the houses locations are marked on the map.
my.sf.point <- st_as_sf(x = home_map,
coords = c("long", "lat"),
crs = "+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0")
# simple plot
# plot(my.sf.point)
# interactive map:
mapview(my.sf.point)## Warning in cbind(`Feature ID` = fid, mat): number of rows of result is not a
## multiple of vector length (arg 1)# convert to sp object if needed
my.sp.point <- as(my.sf.point, "Spatial")Descriptive statistics:
Before using PCA, I checked the statistics of variables. In the first table, there is a summary of non standardized data. However, in the second table, data is standardized.
summary(home_sample1) ## price bedrooms bathrooms sqft_living
## Min. : 85000 Min. :0.000 Min. :0.000 Min. : 620
## 1st Qu.: 315000 1st Qu.:3.000 1st Qu.:1.750 1st Qu.:1410
## Median : 441500 Median :3.000 Median :2.125 Median :1830
## Mean : 537009 Mean :3.312 Mean :2.087 Mean :2029
## 3rd Qu.: 638250 3rd Qu.:4.000 3rd Qu.:2.500 3rd Qu.:2492
## Max. :3000000 Max. :7.000 Max. :5.250 Max. :6900
## sqft_lot floors condition grade
## Min. : 761 Min. :1.000 Min. :1.000 Min. : 4.000
## 1st Qu.: 5000 1st Qu.:1.000 1st Qu.:3.000 1st Qu.: 7.000
## Median : 7744 Median :1.500 Median :3.000 Median : 7.000
## Mean : 17237 Mean :1.497 Mean :3.406 Mean : 7.642
## 3rd Qu.: 10768 3rd Qu.:2.000 3rd Qu.:4.000 3rd Qu.: 8.000
## Max. :1074218 Max. :3.000 Max. :5.000 Max. :12.000
## yr_built lat long
## Min. :1900 Min. :47.19 Min. :-122.5
## 1st Qu.:1953 1st Qu.:47.46 1st Qu.:-122.3
## Median :1977 Median :47.56 Median :-122.2
## Mean :1972 Mean :47.55 Mean :-122.2
## 3rd Qu.:1997 3rd Qu.:47.67 3rd Qu.:-122.1
## Max. :2015 Max. :47.78 Max. :-121.7summary(home_sample) ## price bedrooms bathrooms sqft_living
## Min. :-1.2512 Min. :-3.8498 Min. :-2.84340 Min. :-1.5814
## 1st Qu.:-0.6146 1st Qu.:-0.3627 1st Qu.:-0.45857 1st Qu.:-0.6950
## Median :-0.2644 Median :-0.3627 Median : 0.05247 Median :-0.2238
## Mean : 0.0000 Mean : 0.0000 Mean : 0.00000 Mean : 0.0000
## 3rd Qu.: 0.2802 3rd Qu.: 0.7997 3rd Qu.: 0.56350 3rd Qu.: 0.5195
## Max. : 6.8179 Max. : 4.2868 Max. : 4.31109 Max. : 5.4646
## sqft_lot floors condition grade
## Min. :-0.2678 Min. :-0.929235 Min. :-3.7037 Min. :-3.2597
## 1st Qu.:-0.1989 1st Qu.:-0.929235 1st Qu.:-0.6250 1st Qu.:-0.5746
## Median :-0.1543 Median : 0.005609 Median :-0.6250 Median :-0.5746
## Mean : 0.0000 Mean : 0.000000 Mean : 0.0000 Mean : 0.0000
## 3rd Qu.:-0.1051 3rd Qu.: 0.940453 3rd Qu.: 0.9144 3rd Qu.: 0.3204
## Max. :17.1767 Max. : 2.810141 Max. : 2.4537 Max. : 3.9005
## yr_built lat long
## Min. :-2.4647 Min. :-2.56638 Min. :-1.88346
## 1st Qu.:-0.6384 1st Qu.:-0.64240 1st Qu.:-0.86738
## Median : 0.1886 Median : 0.05065 Median :-0.04999
## Mean : 0.0000 Mean : 0.00000 Mean : 0.00000
## 3rd Qu.: 0.8778 3rd Qu.: 0.82746 3rd Qu.: 0.62798
## Max. : 1.4980 Max. : 1.55922 Max. : 3.24748hist.data.frame(home_sample1)
Matridx of plots:
ggpairs(home_sample)
Correlation matrix:
On the correlation matrix it’s visible that price, bedrooms, bathroom, sqft_living and grade have a strong positive correlation between each other.
cor<-cor(home_sample, method="pearson")
corrplot(cor)
Kaiser-Meyer-Olkin and Bartlett’s test
Before using PCA, first data should be tested whether is PCA testable.
Kaiser-Meyer-Olkin is a test used in order to examine whether the Principal Component Analysis is useful for the given variables or not. Howeverm Bartlett’s test is used to find out whether the correlation matrix for a set of data is the identity matrix. If the identity correlation matrix is confirmed, PCA is not an appropriate measure (Carillo et al., 2019).
Kaiser-Meyer-Olkin (KMO)
Overall MSA = 0.77 is greater than 0.6 threshold, so the PCA can be used based on this test.
KMO(cor)## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = cor)
## Overall MSA = 0.77
## MSA for each item =
## price bedrooms bathrooms sqft_living sqft_lot floors
## 0.74 0.74 0.86 0.79 0.54 0.91
## condition grade yr_built lat long
## 0.65 0.83 0.65 0.66 0.67Bartlett’s test
In the Bartlett’s test, the p-value = 0, it means that correlation matrix is completely different from the identity matrix.
cortest.bartlett(cor, n = 12756)## $chisq
## [1] 60370.19
##
## $p.value
## [1] 0
##
## $df
## [1] 55PCA
PCA is a technique for reducing the dimensionality of datasets, increasing the interpretability of data while preserving the maximum amount of information, and enabling the visualization of multidimensional data.
Number of components
Firstly, we should determine the optimal number of components to remain in the set. To do that I will use Kaiser’s Stopping Rule, Scree plot and Proportion of variance explained.
Kaiser rule
In PCA the Kaiser criterion drops the components, for which the eigenvalues are less than 1 (when the data is standardized). Greater than 1 eigenvalue suggests that the corresponding component explains more variance than a single variable, given that a variable accounts for a unit of variance (Beavers, 2013). Eigenvalues displayed below suggests that 3 components should be chosen.
home_sample.cov<-cov(home_sample)
home_sample.eigen<-eigen(home_sample.cov)
home_sample.eigen$values## [1] 3.9182180 1.7714863 1.3262323 0.8963160 0.7489422 0.6825304 0.6132091
## [8] 0.4212887 0.2794209 0.1923399 0.1500163Scree plot
The second approach relies on the scree plot. The appropriate number of components is chosen based on the elbow method. Scree plot suggests that the right number of component is 4.
pca <- prcomp(home_sample, center = TRUE, scale = TRUE)
fviz_eig(pca, choice = "eigenvalue", ncp = 22, barfill = "hotpink3", barcolor = "hotpink4", linecolor = "brown4", addlabels = TRUE, main = "Eigenvalues")
Proportion of variance explained
According to the last approach: proportion of variance explained, chosen components should explain over 2/3 of the variance. Scree plot represents graphically the percentage of variance explained by every component. The results show that PC1 explains 35.6% of variation. PC2 explains 51.7% of variation. PC3 explains 63.8% of variation. PC4 explains 71,9% of variation.
fviz_screeplot(pca, addlabels = TRUE, barfill = "salmon", barcolor = "tomato3", linecolor = "tomato4")
Components analysis
fviz_pca_ind(pca, col.ind="cos2", geom = "point", gradient.cols = c("green", "yellow", "red" ))
The plot below shows relations between variables and their quality. Variables, which are close to each other are correlated. However, those correlated in negative way are opposite to each other. The higher quality have variables which length is the longest from center.
fviz_pca_var(pca, col.var = "red")
plot(summary(pca)$importance[3,])
Percentage of the contribution to first two components has been shown on plots displayed below. On the first chart, for first component consists of sqft_living, bathrooms, grade, price and floors. The second component consists of lattitude, build year, price and longitude. The third component consists of sqft_lot and condition. The forth component consists of sqft_lot, lat, bedrooms and condition.
PC1 <- fviz_contrib(pca, choice = "var", axes = 1,fill = "#990066",color = "#990066")
PC2 <- fviz_contrib(pca, choice = "var", axes = 2,fill = "#990066",color = "#990066")
PC3 <- fviz_contrib(pca, choice = "var", axes = 3,fill = "#990066",color = "#990066")
PC4 <- fviz_contrib(pca, choice = "var", axes = 4,fill = "#990066",color = "#990066")
grid.arrange(PC1, PC2, PC3, PC4, ncol=3)
library("pdp")##
## Dołączanie pakietu: 'pdp'## Następujący obiekt został zakryty z 'package:purrr':
##
## partialpca_var <- get_pca_var(pca)
fviz_contrib(pca, "var", axes = 1:4, fill = "tomato3", color = "tomato4")
Conclusions
Dimension reduction simply refers to the process of reducing the number of dimensions in a dataset. The aim of this process is to preserve as much information as possible by reducing the number of features by PCA method. Conducted research shows that almost 80% of the variance can be explained by 5 dimensions and 3 dimensions are able to keep almost 2/3 of the information included in the original dataset. Dimension reduction techniques are powerful when it comes to analysis and storage of big datasets.