Regresi dummy

Tugas Minggu 5

Import Data

library(readxl)
library(tidyverse)
data <- read_excel("C:/Users/Admin/Downloads/PSD Kelompok 3 (3).xlsx")
names(data)[names(data) == "Jumlah Ulasan"] <- "J.Ulasan"
head(data)
## # A tibble: 6 × 6
##   Brand     HARGA LOKASI      J.Ulasan RAM   Penyimpanan
##   <chr>     <dbl> <chr>       <chr>    <chr> <chr>      
## 1 iphone  4388000 Jabodetabek 10       4     256        
## 2 iphone  9458000 Jabodetabek 3071     4     128        
## 3 iphone  9409000 Jabodetabek 2713     4     128        
## 4 iphone  5047000 Luar Jawa   87       4     64         
## 5 iphone 11287000 Jabodetabek 567      6     128        
## 6 iphone 21447000 Jabodetabek 732      8     256

Pada tahap ini, Kami akan mengambil data hasil scrapping pada Minggu 3. Data ini adalah Data Penjualan Handphone, dengan Harga sebagai peubah Respon dan 5 Peubah Penjelas. Peubah Penjelas terdiri dari Brand, Lokasi, Ram, Penyimpanan.

Pada Tahap ini Toko tidak kami masukkan ke model atas dasar pertimbangan pengelompokkan yang rumit untuk dilakukan sehingga pada bagian ini kami tidak memasukkan peubah Toko terlebih dahulu dan memodelkan dengan 5 Peubah Penjelas

Melakukan Releveling Pada Data Kategorik

data$Brand <- relevel(as.factor(data$Brand), ref="iphone")
data$LOKASI <- relevel(as.factor(data$LOKASI), ref="Jabodetabek")
data$RAM <- relevel(as.factor(as.numeric(data$RAM)), ref = "6")
data$Penyimpanan <- relevel(as.factor(as.numeric(data$Penyimpanan)), ref = "128")
data$J.Ulasan <- as.numeric(data$J.Ulasan)

Pada tahapan ini , kami melakukan Re-level pada data-data kategorik yaitu Brand, Lokasi , RAM dan Penyimpanan. RAM dan Penyimpanan memang berbentuk data numerik, namun dalam substansinya, angka-angka pada RAM dan Penyimpanan sudah disetting dalam beberapa kategori sehingga dapat dikatakan bahwa data ini lebih ke Kategorik daripada Numerik.

Pada Tahap ini, Kami juga menentukan Reference yaitu Untuk Brand Kami menerapkan Reference di kategori Iphone, lalu untuk Lokasi kamu menerapkan reference di Jabodetabek, 6 Untuk Ram dan 128 untuk Penyimpanan.

Terakhir kami menyiapkan data ulasan sebagai numeric. Hal ini dilakukan agar data tetap dibaca sebagai numerik pada model.

Eksplorasi

hist(data$HARGA)

Untuk Visualisasi Sebelum Ke Model, Dapat dilihat bahwa Kecenderungan Harga menjulur ke kanan. Hal ini mengartikan bahwa harga Handphone menyebar di daerah 5 Jutaan. Kemudian data mulai turun secara signifikan sampai ke harga puluhan juta. Sebaran data hasil histogram ini juga mengindikasikan adanya outlier karena data tidak terdistribusi secara merata, untuk itu kami akan melakukan pendeteksian pencilan setelah pemodelan.

Pemodelan

model <- lm(HARGA ~ Brand+ LOKASI + RAM + Penyimpanan+ J.Ulasan, data=data) 
summary(model)
## 
## Call:
## lm(formula = HARGA ~ Brand + LOKASI + RAM + Penyimpanan + J.Ulasan, 
##     data = data)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -12853595  -1607087   -586536   1435603  14613759 
## 
## Coefficients:
##                       Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          1.102e+07  1.678e+05  65.685  < 2e-16 ***
## Brandasus           -7.748e+06  4.688e+05 -16.529  < 2e-16 ***
## Brandinfinix        -9.997e+06  2.215e+05 -45.142  < 2e-16 ***
## Brandoppo           -8.896e+06  2.553e+05 -34.848  < 2e-16 ***
## BrandRealme         -8.830e+06  2.508e+05 -35.211  < 2e-16 ***
## BrandSamsung        -7.186e+06  1.737e+05 -41.364  < 2e-16 ***
## Brandvivo           -8.731e+06  1.980e+05 -44.103  < 2e-16 ***
## Brandxiaomi         -9.110e+06  1.778e+05 -51.228  < 2e-16 ***
## LOKASIBali           3.884e+05  4.681e+05   0.830 0.406761    
## LOKASIDI Yogyakarta -6.591e+05  7.483e+05  -0.881 0.378479    
## LOKASIJawa Barat    -1.784e+04  2.283e+05  -0.078 0.937735    
## LOKASIJawa Tengah   -1.905e+05  4.780e+05  -0.399 0.690263    
## LOKASIJawa Timur     3.799e+05  1.773e+05   2.142 0.032244 *  
## LOKASILuar Jawa      4.378e+05  1.671e+05   2.620 0.008841 ** 
## RAM1                -1.117e+07  1.327e+06  -8.413  < 2e-16 ***
## RAM2                -8.142e+06  5.753e+05 -14.153  < 2e-16 ***
## RAM3                -6.381e+06  3.622e+05 -17.618  < 2e-16 ***
## RAM4                -2.780e+06  1.822e+05 -15.259  < 2e-16 ***
## RAM8                 9.669e+05  1.661e+05   5.820 6.50e-09 ***
## RAM12                4.762e+06  2.669e+05  17.842  < 2e-16 ***
## RAM16                8.399e+06  6.345e+05  13.237  < 2e-16 ***
## RAM18                1.271e+07  2.100e+06   6.053 1.59e-09 ***
## RAM24                1.567e+06  1.742e+06   0.899 0.368505    
## Penyimpanan8        -3.033e+06  2.928e+06  -1.036 0.300349    
## Penyimpanan16        2.474e+06  1.156e+06   2.140 0.032437 *  
## Penyimpanan32        3.742e+06  6.041e+05   6.194 6.63e-10 ***
## Penyimpanan64       -5.358e+05  1.917e+05  -2.795 0.005226 ** 
## Penyimpanan256       5.122e+05  1.379e+05   3.714 0.000207 ***
## Penyimpanan512       2.456e+06  2.494e+05   9.848  < 2e-16 ***
## J.Ulasan            -3.379e+02  2.808e+02  -1.203 0.228918    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 2870000 on 3091 degrees of freedom
##   (25 observations deleted due to missingness)
## Multiple R-squared:  0.6273, Adjusted R-squared:  0.6239 
## F-statistic: 179.4 on 29 and 3091 DF,  p-value: < 2.2e-16

Didapatkan Model Sebagai Berikut ini , Dimana R-Squared 62%. Didapat pula bahwa mayoritas peubah yang digunaka signfikan dalam taraf kepercayaan 95 %. Namun ada beberapa peubah juga yang tidak signifkan seperti Jumlah Ulasan.

Periksa Asumsi

plot(model)

## Warning in sqrt(crit * p * (1 - hh)/hh): NaNs produced

## Warning in sqrt(crit * p * (1 - hh)/hh): NaNs produced

Dari Plot Residual Vs Fitted, Asumsi Homoskedastisitas tidak terpenuhi karena banyaknya residual data hasil tidak menyebar di nilai tengah dimana y= 0 . Sehingga dapat disimpulkan bahwa terjadi Heteroskedasitas yang artinya ragam sisanya tidak homogen.

Dari Plot QQ-Residual , walaupun beberapa data menyebar normal di tengah, namun, mayoritas data di ujung dan di belakannya tidak berada di garis kenormalan data. Sehinga dapat dikatakan data tidak menyebar normal namun harus tetap dilakukan uji secara formal. Data ini bisa berpotensi tidak normal karena adanya pencilan.

Dari Plot Fitted Values Vs Standarad Residual dapat dilihat bahwa data cenderung menyebar dan membentuk pola, hal ini mengindikasikan bahwa nilai harapan sisaan pada data tidak 0 . karena adanya pola yang terbentuk.

library(car)
## Warning: package 'car' was built under R version 4.3.2
## Loading required package: carData
## Warning: package 'carData' was built under R version 4.3.2
## 
## Attaching package: 'car'
## The following object is masked from 'package:dplyr':
## 
##     recode
## The following object is masked from 'package:purrr':
## 
##     some
vif(model)
##                 GVIF Df GVIF^(1/(2*Df))
## Brand       2.494361  7        1.067466
## LOKASI      1.130748  6        1.010293
## RAM         7.462211  9        1.118131
## Penyimpanan 4.322606  6        1.129741
## J.Ulasan    1.067401  1        1.033151

VIF pada Seluruh Data Berada dibawah 10, yang artinya cukup bukti untuk mengatakan tidak ada multikolinearitas.

Uji Formal

#normalitas
shapiro.test(residuals(model))
## 
##  Shapiro-Wilk normality test
## 
## data:  residuals(model)
## W = 0.91741, p-value < 2.2e-16
# 2. Homoskedastisitas

library(lmtest)
## Warning: package 'lmtest' was built under R version 4.3.3
## Loading required package: zoo
## Warning: package 'zoo' was built under R version 4.3.2
## 
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
bptest(model)
## 
##  studentized Breusch-Pagan test
## 
## data:  model
## BP = 630.37, df = 29, p-value < 2.2e-16

Dapat dilihat bahwa data tidak menyebar normal dan terjadi heteroskedastitsitas.

library(olsrr)
## Warning: package 'olsrr' was built under R version 4.3.2
## 
## Attaching package: 'olsrr'
## The following object is masked from 'package:datasets':
## 
##     rivers
library(ggplot2)

# Membuat plot leverage residuals
p <- ols_plot_resid_lev(model)

# Menghapus layer teks yang biasanya mengandung label urutan data
p$layers <- p$layers[sapply(p$layers, function(x) class(x$geom)[1] != "GeomText")]

# Tampilkan plot tanpa label urutan data
p

Jika dilihat masih banyak data yang merupakan outlier dan menjadi titik Leverage, sehingga mungkin saja data-data ini menyebabkan distribusi menjadi tidak normal dan merambat pada pelanggaran asumsi lainnya

Uji Coba Transformasi untuk penanganan

data$HARGA.t <- log(data$HARGA)
data$HARGA.t <- log(data$HARGA)
modelt <- lm(HARGA.t ~ Brand+LOKASI + RAM + Penyimpanan+J.Ulasan, data=data) 
summary(model)
## 
## Call:
## lm(formula = HARGA ~ Brand + LOKASI + RAM + Penyimpanan + J.Ulasan, 
##     data = data)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -12853595  -1607087   -586536   1435603  14613759 
## 
## Coefficients:
##                       Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          1.102e+07  1.678e+05  65.685  < 2e-16 ***
## Brandasus           -7.748e+06  4.688e+05 -16.529  < 2e-16 ***
## Brandinfinix        -9.997e+06  2.215e+05 -45.142  < 2e-16 ***
## Brandoppo           -8.896e+06  2.553e+05 -34.848  < 2e-16 ***
## BrandRealme         -8.830e+06  2.508e+05 -35.211  < 2e-16 ***
## BrandSamsung        -7.186e+06  1.737e+05 -41.364  < 2e-16 ***
## Brandvivo           -8.731e+06  1.980e+05 -44.103  < 2e-16 ***
## Brandxiaomi         -9.110e+06  1.778e+05 -51.228  < 2e-16 ***
## LOKASIBali           3.884e+05  4.681e+05   0.830 0.406761    
## LOKASIDI Yogyakarta -6.591e+05  7.483e+05  -0.881 0.378479    
## LOKASIJawa Barat    -1.784e+04  2.283e+05  -0.078 0.937735    
## LOKASIJawa Tengah   -1.905e+05  4.780e+05  -0.399 0.690263    
## LOKASIJawa Timur     3.799e+05  1.773e+05   2.142 0.032244 *  
## LOKASILuar Jawa      4.378e+05  1.671e+05   2.620 0.008841 ** 
## RAM1                -1.117e+07  1.327e+06  -8.413  < 2e-16 ***
## RAM2                -8.142e+06  5.753e+05 -14.153  < 2e-16 ***
## RAM3                -6.381e+06  3.622e+05 -17.618  < 2e-16 ***
## RAM4                -2.780e+06  1.822e+05 -15.259  < 2e-16 ***
## RAM8                 9.669e+05  1.661e+05   5.820 6.50e-09 ***
## RAM12                4.762e+06  2.669e+05  17.842  < 2e-16 ***
## RAM16                8.399e+06  6.345e+05  13.237  < 2e-16 ***
## RAM18                1.271e+07  2.100e+06   6.053 1.59e-09 ***
## RAM24                1.567e+06  1.742e+06   0.899 0.368505    
## Penyimpanan8        -3.033e+06  2.928e+06  -1.036 0.300349    
## Penyimpanan16        2.474e+06  1.156e+06   2.140 0.032437 *  
## Penyimpanan32        3.742e+06  6.041e+05   6.194 6.63e-10 ***
## Penyimpanan64       -5.358e+05  1.917e+05  -2.795 0.005226 ** 
## Penyimpanan256       5.122e+05  1.379e+05   3.714 0.000207 ***
## Penyimpanan512       2.456e+06  2.494e+05   9.848  < 2e-16 ***
## J.Ulasan            -3.379e+02  2.808e+02  -1.203 0.228918    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 2870000 on 3091 degrees of freedom
##   (25 observations deleted due to missingness)
## Multiple R-squared:  0.6273, Adjusted R-squared:  0.6239 
## F-statistic: 179.4 on 29 and 3091 DF,  p-value: < 2.2e-16

Didapatkan R-Squared yang lebih tinggi daripada model sebelum di Transformasi, namun tujuannya adalah melihat apakah bisa untuk menyelesaikan permasalahan asumsi maka langsung kita cek

Pengecekan

#normalitas
shapiro.test(residuals(modelt))
## 
##  Shapiro-Wilk normality test
## 
## data:  residuals(modelt)
## W = 0.99178, p-value = 2.147e-12
# 2. Homoskedastisitas

library(lmtest)

bptest(modelt)
## 
##  studentized Breusch-Pagan test
## 
## data:  modelt
## BP = 313.04, df = 29, p-value < 2.2e-16

Dapat dilihat bahwa Uji Kenormalan sedikit menambah p-value sehingga hal ini bisa saja menjadi salah satu penanganan namun belum bisa menanganin secara keseluruhan. Maka kami tetap menggunakan Model awal karena interpretasi yang lebih mudah.