1 . Pendahuluan

Project ini dilakukan untuk tugas Learning By Building sebagai pendalaman dan pembelajaran mandiri atas materi Regression Model. Data set yang digunakan adalah harga dan atribut “54,000 round-cut diamonds” yang diperoleh dari situs Kaggle. Analisis yang dilakukan akan meliputi eksplorasi data dan membuat model regresi linear untuk memprediksi harga berdasarkan atribut “carat”.

Harga berlian dipengaruhi oleh atribut 4C. Walaupun pada project ini nantinya harga akan diprediksi berdasarkan atribut “carat”, namun atribut lainnya akan dieksplorasi datanya untuk memperkaya pemahaman terhadap data berlian.

Carat - berat berlian (1 carat setara dengan 200 milligram)

Cut - Seberapa baik permukaan berlian di potong sehingga memantulkan warnanya.

Clarity - Seberapa jernih berlian tanpa dengan noda/muatan lain di dalamnya ketika dilihat dalam pengamatan pembesaran 10X.

Color - Seberapa putih bening warna yang dipantulkan berlian.


2 . Import Data

diamond <- 
read.csv("data_input_diamond/Diamonds Prices2022.csv")
head(diamond)
##   X carat       cut color clarity depth table price    x    y    z
## 1 1  0.23     Ideal     E     SI2  61.5    55   326 3.95 3.98 2.43
## 2 2  0.21   Premium     E     SI1  59.8    61   326 3.89 3.84 2.31
## 3 3  0.23      Good     E     VS1  56.9    65   327 4.05 4.07 2.31
## 4 4  0.29   Premium     I     VS2  62.4    58   334 4.20 4.23 2.63
## 5 5  0.31      Good     J     SI2  63.3    58   335 4.34 4.35 2.75
## 6 6  0.24 Very Good     J    VVS2  62.8    57   336 3.94 3.96 2.48


3 Eksplorasi Data

3.1 Pemeriksaan Struktur Data

glimpse(diamond)
## Rows: 53,943
## Columns: 11
## $ X       <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18,…
## $ carat   <dbl> 0.23, 0.21, 0.23, 0.29, 0.31, 0.24, 0.24, 0.26, 0.22, 0.23, 0.…
## $ cut     <chr> "Ideal", "Premium", "Good", "Premium", "Good", "Very Good", "V…
## $ color   <chr> "E", "E", "E", "I", "J", "J", "I", "H", "E", "H", "J", "J", "F…
## $ clarity <chr> "SI2", "SI1", "VS1", "VS2", "SI2", "VVS2", "VVS1", "SI1", "VS2…
## $ depth   <dbl> 61.5, 59.8, 56.9, 62.4, 63.3, 62.8, 62.3, 61.9, 65.1, 59.4, 64…
## $ table   <dbl> 55, 61, 65, 58, 58, 57, 57, 55, 61, 61, 55, 56, 61, 54, 62, 58…
## $ price   <int> 326, 326, 327, 334, 335, 336, 336, 337, 337, 338, 339, 340, 34…
## $ x       <dbl> 3.95, 3.89, 4.05, 4.20, 4.34, 3.94, 3.95, 4.07, 3.87, 4.00, 4.…
## $ y       <dbl> 3.98, 3.84, 4.07, 4.23, 4.35, 3.96, 3.98, 4.11, 3.78, 4.05, 4.…
## $ z       <dbl> 2.43, 2.31, 2.31, 2.63, 2.75, 2.48, 2.47, 2.53, 2.49, 2.39, 2.…

Ada data yang akan didrop karena tidak diperlukan, yakni: “X”, dan juga terdapat beberapa data yang tipenya masih harus disesuaikan, yakni: Cut, Color, dan Clarity menjadi factor. Selain itu juga ada dua data yang juga tidak akan digunakan, baik dalam ekplorasi maupun dalam analisis kali ini, yakni: depth dan table karena kedua data ini akan diwakilkan oleh data dimensi (x, y, z).

diamond <-
  diamond %>%
  select(-c("X", "depth", "table")) %>% 
  mutate_at(vars(cut, color, clarity), as.factor)
glimpse(diamond)
## Rows: 53,943
## Columns: 8
## $ carat   <dbl> 0.23, 0.21, 0.23, 0.29, 0.31, 0.24, 0.24, 0.26, 0.22, 0.23, 0.…
## $ cut     <fct> Ideal, Premium, Good, Premium, Good, Very Good, Very Good, Ver…
## $ color   <fct> E, E, E, I, J, J, I, H, E, H, J, J, F, J, E, E, I, J, J, J, I,…
## $ clarity <fct> SI2, SI1, VS1, VS2, SI2, VVS2, VVS1, SI1, VS2, VS1, SI1, VS1, …
## $ price   <int> 326, 326, 327, 334, 335, 336, 336, 337, 337, 338, 339, 340, 34…
## $ x       <dbl> 3.95, 3.89, 4.05, 4.20, 4.34, 3.94, 3.95, 4.07, 3.87, 4.00, 4.…
## $ y       <dbl> 3.98, 3.84, 4.07, 4.23, 4.35, 3.96, 3.98, 4.11, 3.78, 4.05, 4.…
## $ z       <dbl> 2.43, 2.31, 2.31, 2.63, 2.75, 2.48, 2.47, 2.53, 2.49, 2.39, 2.…


3.2 Pemeriksaan Kelengkapan Data

summary(is.na(diamond))
##    carat            cut            color          clarity       
##  Mode :logical   Mode :logical   Mode :logical   Mode :logical  
##  FALSE:53943     FALSE:53943     FALSE:53943     FALSE:53943    
##    price             x               y               z          
##  Mode :logical   Mode :logical   Mode :logical   Mode :logical  
##  FALSE:53943     FALSE:53943     FALSE:53943     FALSE:53943


3.3 Pemeriksaan Outlier dan Eksplorasi Data Numerik

boxplot(diamond$carat)

IQR(diamond$carat)
## [1] 0.64
quantile(diamond$carat)
##   0%  25%  50%  75% 100% 
## 0.20 0.40 0.70 1.04 5.01
upwhisker_carat <- 1.04 + 1.5 * 0.64
upwhisker_carat
## [1] 2
boxplot(diamond$price)

IQR(diamond$price)
## [1] 4374
quantile(diamond$price)
##    0%   25%   50%   75%  100% 
##   326   950  2401  5324 18823
upwhisker_price <- 4374 + 1.5 * 5324
upwhisker_price
## [1] 12360
boxplot(diamond$x, diamond$y, diamond$z)

IQR(diamond$x)
## [1] 1.83
quantile(diamond$x)
##    0%   25%   50%   75%  100% 
##  0.00  4.71  5.70  6.54 10.74
upwhisker_x <- 6.54 + 1.5 * 1.83
upwhisker_x
## [1] 9.285
IQR(diamond$y)
## [1] 1.82
quantile(diamond$y)
##    0%   25%   50%   75%  100% 
##  0.00  4.72  5.71  6.54 58.90
upwhisker_y <- 6.54 + 1.5 * 1.82
upwhisker_y
## [1] 9.27
IQR(diamond$z)
## [1] 1.13
quantile(diamond$z)
##    0%   25%   50%   75%  100% 
##  0.00  2.91  3.53  4.04 31.80
upwhisker_z <- 4.04 + 1.5 * 1.13
upwhisker_z
## [1] 5.735


3.4 Dataset Baru Tanpa Outlier

diamond_no_outlier <- 
  diamond %>% 
  filter(carat<2 & price< 12360 & x<9.285 & x>0.3 & y<9.27 & y>0.25 & z<5.735 & z>2)

Melihat hubungan atribut dimensi “x” terhadap nilai carat

ggplot(data = diamond_no_outlier, aes(x = x, y = carat)) +
  geom_point()+
  geom_smooth(method = "lm", level = 0.95)+
  theme_minimal()
## `geom_smooth()` using formula 'y ~ x'

Melihat hubungan atribut dimensi “y” terhadap nilai carat

ggplot(data = diamond_no_outlier, aes(x = y, y = carat)) +
  geom_point()+
  geom_smooth(method = "lm", level = 0.95)+
  theme_minimal()
## `geom_smooth()` using formula 'y ~ x'

Melihat hubungan atribut dimensi “y” terhadap nilai carat

ggplot(data = diamond_no_outlier, aes(x = z, y = carat)) +
  geom_point()+
  geom_smooth(method = "lm", level = 0.95)+
  theme_minimal()
## `geom_smooth()` using formula 'y ~ x'

model_carat <- lm(formula = carat~x+y+z, data = diamond_no_outlier)
summary(model_carat)
## 
## Call:
## lm(formula = carat ~ x + y + z, data = diamond_no_outlier)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.53097 -0.04595 -0.01327  0.03732  0.39082 
## 
## Coefficients:
##              Estimate Std. Error  t value Pr(>|t|)    
## (Intercept) -1.376364   0.001535 -896.945  < 2e-16 ***
## x            0.194653   0.004752   40.960  < 2e-16 ***
## y            0.016405   0.004697    3.493 0.000478 ***
## z            0.266689   0.003127   85.295  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.05895 on 50341 degrees of freedom
## Multiple R-squared:  0.975,  Adjusted R-squared:  0.975 
## F-statistic: 6.546e+05 on 3 and 50341 DF,  p-value: < 2.2e-16

Dapat dilihat dari ketiga grafik hubungan di atas bahwa dimensi adalah pembentuk dari nilai carat, sehingga memiliki hubungan linear yang cukup besar.


3.5 Eksplorasi Data Kategorik

ggplot(data = diamond_no_outlier)+
  geom_point(mapping = aes(x = carat, y = price, color = cut))+
  facet_wrap(~cut) +
  labs(title = "Hubungan Price dan Carat Pada Tiap Jenis Cut")

ggplot(data = diamond_no_outlier)+
  geom_point(mapping = aes(x = carat, y = price, color = color))+
  facet_wrap(~color) +
  labs(title = "Hubungan Price dan Carat Pada Tiap Jenis Color")

Pada project ini juga akan dicoba membuat model yang menggunakan satu jenis kategori Cut dan Color saja untuk dibandingkan dengan model yang melibatkan seluruh jenis Cut & Color. Jenis cut yang dipilih adalah Premium & Very Good sementara Color adalah kategori warna reguler, yaitu: G, H, I, J.

diamond_no_outlier_cutcolor <- 
  diamond_no_outlier %>%
  filter(color==c("G", "H", "I", "J") & cut==c("Premium", "Very Good"))
## Warning in `==.default`(color, c("G", "H", "I", "J")): longer object length is
## not a multiple of shorter object length
## Warning in is.na(e1) | is.na(e2): longer object length is not a multiple of
## shorter object length
## Warning in `==.default`(cut, c("Premium", "Very Good")): longer object length is
## not a multiple of shorter object length
## Warning in is.na(e1) | is.na(e2): longer object length is not a multiple of
## shorter object length
head(diamond_no_outlier_cutcolor)
##   carat       cut color clarity price    x    y    z
## 1  0.23 Very Good     H     VS1   338 4.00 4.05 2.39
## 2  0.30 Very Good     J     SI1   351 4.21 4.27 2.66
## 3  0.31 Very Good     J     SI1   353 4.39 4.43 2.62
## 4  0.24   Premium     I     VS1   355 3.97 3.94 2.47
## 5  0.30 Very Good     J     VS2   357 4.28 4.30 2.67
## 6  0.29 Very Good     H     SI2   404 4.33 4.37 2.64


4 . Pembuatan Model

Pada kasus ini, kita ingin memprediksi harga berlian berdasarkan nilai carat

  • Variabel Target (y): Price

  • Variabel Prediktor (x): Carat

Namun project ini akan menggunakan 3 jenis data untuk saling dibandingkan model mana yang memiliki performa terbaik.

  • Dataset diamond dengan outlier

  • Dataset diamond tanpa outlier

  • Dataset diamond tanpa outlier pada kategori cut “Premium & Very Good” dan Color “G, H, I, J”.

model_outlier <- lm(formula = price ~ carat, data = diamond)
model_no_outlier <- lm(formula = price ~ carat, data = diamond_no_outlier)
model_no_outlier_cutcolor <- lm(formula = price ~ carat, data = diamond_no_outlier_cutcolor)


5 . Evaluasi Model

Model akan dievaluasi menggunakan 3 indikator untuk memilih model yang terbaik:

  • R2_adjusted dengan nilai tertinggi

  • AIC dengan nilai terendah

  • RMSE dengan nilai terendah

comparison <- compare_performance(model_outlier, model_no_outlier, model_no_outlier_cutcolor)
## Warning: When comparing models, please note that probably not all models were fit
##   from same data.
as.data.frame(comparison %>% select(Name, R2_adjusted, AIC, RMSE))
##                        Name R2_adjusted       AIC     RMSE
## 1             model_outlier   0.8493277 945516.39 1548.494
## 2          model_no_outlier   0.8426533 848520.17 1105.504
## 3 model_no_outlier_cutcolor   0.8656843  25606.29 1099.057


6 . Kesimpulan

  1. Nilai dengan performa terbaik secara berturut-turut adalah model tanpa outlier yang dikelompokkan berdasarkan jenis cut dan color tertentu (model_no_outlier_cutcolor), diikuti oleh model umum tanpa outlier (model_no_outlier), dan model umum dengan outlier (model_outlier).

  2. Model_no_outlier_cutcolor menjadi model dengan performa terbaik menunjukkan perlunya pendekatan dengan membuat model yang spesifik untuk jenis cut dan color yang berbeda.

  3. Model_no_outlier memiliki performa yang lebih baik dibandingkan model_outlier berdasarkan AIC dan RMSE. Hal ini menunjukkan bahwa jika pun analyst tidak membuat model spesifik berdasarkan jenis cut dan color, analyst tetap memperhatikan keberadaaan outlier dan sebisa mungkin melakukan cleansing agar model yang dihasilkan bisa memiliki performa yang lebih baik.