Diamond Price Estimations
Ramazan Eraslan
9/10/2020
Introduction
This report aims to analyze the certain aspects of the diamonds dateset in ggplot2 package and make price estimation for diamonds via using Classification and Regression Tree (CART) method.
Loading Required Libraries
library(tidyverse)
library(rpart)
library(rpart.plot)
library(Metrics)Exploratory Data Analysis
summary(diamonds)## carat cut color clarity depth
## Min. :0.2000 Fair : 1610 D: 6775 SI1 :13065 Min. :43.00
## 1st Qu.:0.4000 Good : 4906 E: 9797 VS2 :12258 1st Qu.:61.00
## Median :0.7000 Very Good:12082 F: 9542 SI2 : 9194 Median :61.80
## Mean :0.7979 Premium :13791 G:11292 VS1 : 8171 Mean :61.75
## 3rd Qu.:1.0400 Ideal :21551 H: 8304 VVS2 : 5066 3rd Qu.:62.50
## Max. :5.0100 I: 5422 VVS1 : 3655 Max. :79.00
## J: 2808 (Other): 2531
## table price x y
## Min. :43.00 Min. : 326 Min. : 0.000 Min. : 0.000
## 1st Qu.:56.00 1st Qu.: 950 1st Qu.: 4.710 1st Qu.: 4.720
## Median :57.00 Median : 2401 Median : 5.700 Median : 5.710
## Mean :57.46 Mean : 3933 Mean : 5.731 Mean : 5.735
## 3rd Qu.:59.00 3rd Qu.: 5324 3rd Qu.: 6.540 3rd Qu.: 6.540
## Max. :95.00 Max. :18823 Max. :10.740 Max. :58.900
##
## z
## Min. : 0.000
## 1st Qu.: 2.910
## Median : 3.530
## Mean : 3.539
## 3rd Qu.: 4.040
## Max. :31.800
## ggplot(diamonds,aes(x=carat,y=price,color=color))+geom_point()+xlim(c(0,3))+facet_wrap(clarity~.)+ggtitle("'Price vs Carat Plot' for Different Colors and Clarities")
This plot shows that price and carat of a diamond are directly proportional. Diamonds with the color denoted by D, have relatively low carat.On the other hand, diamonds with the color denoted by J,generally have high carat. Plots also show that, price of a diamond with color D is higher than the diamonds with other colors, when their carats are the same.
ggplot(diamonds,aes(x=cut,fill=color))+geom_bar(position = "dodge")+ggtitle("Number of Diamaonds According to Their Cut and Color")
ggplot(diamonds,aes(x=price))+geom_histogram()+facet_wrap(cut~.)+ggtitle("Number of Diamonds Accoridng to Their Price and Cut")
ggplot(diamonds,aes(x=carat,fill=cut))+geom_histogram(position = "dodge")+xlim(c(0,3))+ggtitle("Number of Diamonds Accoridng to Their Carat and Cut")
Price Estimation with CART
Splitting data into train and test datasets
set.seed(503)
diamonds_test <- diamonds %>% mutate(diamond_id = row_number()) %>%
group_by(cut, color, clarity) %>% sample_frac(0.2) %>% ungroup()
diamonds_train <- anti_join(diamonds %>% mutate(diamond_id = row_number()),
diamonds_test, by = "diamond_id")diamonds_train## # A tibble: 43,143 x 11
## carat cut color clarity depth table price x y z diamond_id
## <dbl> <ord> <ord> <ord> <dbl> <dbl> <int> <dbl> <dbl> <dbl> <int>
## 1 0.21 Premium E SI1 59.8 61 326 3.89 3.84 2.31 2
## 2 0.23 Good E VS1 56.9 65 327 4.05 4.07 2.31 3
## 3 0.290 Premium I VS2 62.4 58 334 4.2 4.23 2.63 4
## 4 0.31 Good J SI2 63.3 58 335 4.34 4.35 2.75 5
## 5 0.24 Very Good I VVS1 62.3 57 336 3.95 3.98 2.47 7
## 6 0.26 Very Good H SI1 61.9 55 337 4.07 4.11 2.53 8
## 7 0.22 Fair E VS2 65.1 61 337 3.87 3.78 2.49 9
## 8 0.23 Very Good H VS1 59.4 61 338 4 4.05 2.39 10
## 9 0.3 Good J SI1 64 55 339 4.25 4.28 2.73 11
## 10 0.23 Ideal J VS1 62.8 56 340 3.93 3.9 2.46 12
## # … with 43,133 more rowsdiamonds_test## # A tibble: 10,797 x 11
## carat cut color clarity depth table price x y z diamond_id
## <dbl> <ord> <ord> <ord> <dbl> <dbl> <int> <dbl> <dbl> <dbl> <int>
## 1 1.7 Fair D I1 64.7 56 5617 7.46 7.37 4.8 13776
## 2 0.580 Fair D SI2 65.1 58 1156 5.25 5.22 3.41 40690
## 3 1 Fair D SI2 65.6 66 3767 6.1 6.01 3.97 5152
## 4 1.05 Fair D SI2 65.4 59 3816 6.3 6.24 4.1 5359
## 5 0.7 Fair D SI2 64.5 60 2167 5.53 5.47 3.55 49828
## 6 0.9 Fair D SI2 64.6 59 3847 6.04 6.01 3.89 5510
## 7 1.01 Fair D SI2 64.6 56 3003 6.31 6.24 4.05 1555
## 8 1.1 Fair D SI2 64.6 54 4725 6.56 6.49 4.22 10151
## 9 0.62 Fair D SI2 64.6 57 1410 5.39 5.33 3.46 43397
## 10 1.5 Fair D SI2 68.8 57 7469 6.9 6.86 4.73 18359
## # … with 10,787 more rowsPreperation of the data and creating the model
diamond_id column was omitted from both diamonds_train and diamonds_test datasets in order to create model formula easily. Model was created by rpart() function. In the model, price is the dependent variable and all other variables are independent variables. Method argument of the rpart() function is “anova” because the price variable is numeric rather than class.
diamond_train<-diamonds_train%>%
select(-diamond_id)
diamond_test<-diamonds_test%>%
select(-diamond_id)
model<-rpart(formula = price~.,data =diamond_train, method = "anova" )Decision Tree
rpart.plot(model)
Evaluating the model
plotcp(model)
print(model$cptable)## CP nsplit rel error xerror xstd
## 1 0.60913716 0 1.0000000 1.0000357 0.009817373
## 2 0.18517972 1 0.3908628 0.3909391 0.004372856
## 3 0.03361554 2 0.2056831 0.2061950 0.002303084
## 4 0.02661853 3 0.1720676 0.1726668 0.002299963
## 5 0.02583190 4 0.1454491 0.1525199 0.002060203
## 6 0.01000000 5 0.1196172 0.1209142 0.001742561Complexity Parameter(CP) plot and table show that automatic splitting number (6) is the optimum number of splits for this tree, since it minimizes the xerror term.
Predictions
predictions<-predict(model,diamonds_test,type = "vector")
predict_vs_actual<- diamond_test %>%
select(price)%>%
mutate(prediction=predictions, abs_difference=abs(price-prediction),abs_percentage=abs(price-prediction)/price)
predict_vs_actual## # A tibble: 10,797 x 4
## price prediction abs_difference abs_percentage
## <int> <dbl> <dbl> <dbl>
## 1 5617 10941. 5324. 0.948
## 2 1156 1050. 106. 0.0914
## 3 3767 5401. 1634. 0.434
## 4 3816 5401. 1585. 0.415
## 5 2167 3060. 893. 0.412
## 6 3847 3060. 787. 0.205
## 7 3003 5401. 2398. 0.799
## 8 4725 5401. 676. 0.143
## 9 1410 1050. 360. 0.255
## 10 7469 5401. 2068. 0.277
## # … with 10,787 more rowsErrors
Root Mean Squared Error (RMSE) and Mean Absolute (MAE) Error terms for predictions:
errors<-c(RMSE=Metrics::rmse(actual = diamond_test$price,predicted = predictions),MAE=
Metrics::mae(actual =diamond_test$price,predicted = predictions ))
errors## RMSE MAE
## 1379.1496 890.0513