REGRESI PROBIT

Tujuan Praktikum

  1. Mengenal Program R
  2. Mengenal Program R untuk konsep analisis data kategorikR

Dasar Teori

Regresi probit adalah salah satu metode yang dapat digunakan untuk mendeskripsikan hubungan peubah respon yang bersifat biner dengan satu atau lebih peubah penjelas yang bersifat kontinu, kategorik atau kombinasi keduanya (Agresti 2002).

Model regresi probit merupakan pengembangan dari model regresi logistik denganmenggunakan fungsi normal kumulatif sedangkan pada regresi logistik menggunakan fungsi logistik kumulatif. Istilah probit berasal dari singkatan probability unit yang dikenalkan pada tahun 1930-an oleh Chester Bliss.

Variabel dependen (variabel respon) biasa disimbolkan Y dengan skala pengukuran dikotomus (biner), dan variabel independen (variable prediktor) biasa disimbolkan X yang skala pengukuran bersifat dikotomus, polikotomus atau kontinu.

Jika

Dan diketahui

maka

dengan \(Φ[.]\) Adalah fungsi kumulatif distribusi normal standar.

Dengan cara yang sama jika variabel bebas lebih dari 1, maka:
\(Z=Xβ+e\)
Dengan Z merupakan variable yang tidak diobservasi, dan observasinya adalah
\(Y=1\) \(Jika Z>0\)
\(Y=0\) \(Jika Z≤0\)

Dengan ε adalah residual yang diasumsikan berdistribusi normal dengan mean nol (0) dan varian satu (1).
\(P(y_1=1│x)=Φ(X_1 β)\)
\(P(y_1=0│x)=1-Φ(X_1 β)\)

Penduga parameter regresi logistik diperoleh dengan menggunakan metode penduga kemungkinan maksimum. Parameter Beta diduga dengan cara memaksimumkan fungsi kemungkinan. Pengamatan diasumsikan saling bebas.

Pogram R

Regresi Pobit

Eksplorasi Data
Install Package

library(readxl)
library(broom)
library(caret)
## Loading required package: ggplot2
## Loading required package: lattice
library(DataExplorer)
library(grid)
library(ISLR)
library(pscl)
## Classes and Methods for R originally developed in the
## Political Science Computational Laboratory
## Department of Political Science
## Stanford University (2002-2015),
## by and under the direction of Simon Jackman.
## hurdle and zeroinfl functions by Achim Zeileis.
library(tidyverse)
## -- Attaching core tidyverse packages ------------------------ tidyverse 2.0.0 --
## v dplyr     1.1.4     v readr     2.1.5
## v forcats   1.0.0     v stringr   1.5.1
## v lubridate 1.9.3     v tibble    3.2.1
## v purrr     1.0.2     v tidyr     1.3.1
## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()
## x purrr::lift()   masks caret::lift()
## i Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(caTools)
library(pROC)
## Type 'citation("pROC")' for a citation.
## 
## Attaching package: 'pROC'
## 
## The following objects are masked from 'package:stats':
## 
##     cov, smooth, var
library(dplyr)

Input Data
Data yang digunakan yaitu data bangkitan random terdiri dari 4 variabel dengan 100 pengamatan per variable.

# Set seed untuk hasil konsisten
set.seed(123)
# Membuat data acak untuk dua variabel kategorik dan satu target (Beli)
Jenis_Kelamin <- sample(0:1, 100, replace = TRUE)  # 0 = Laki-laki, 1 = Perempuan
Pekerjaan <- sample(0:1, 100, replace = TRUE)  # 0 = Tidak bekerja, 1 = Bekerja
Beli <- sample(0:1, 100, replace = TRUE)  # 0 = Tidak beli, 1 = Beli
# Membuat data frame
data <- data.frame(Jenis_Kelamin, Pekerjaan, Beli)

Eksplor Data

# Eksplorasi Data Awal
# Melihat struktur data
dim(data)
## [1] 100   3
glimpse(data)
## Rows: 100
## Columns: 3
## $ Jenis_Kelamin <int> 0, 0, 0, 1, 0, 1, 1, 1, 0, 0, 1, 1, 1, 0, 1, 0, 1, 0, 0,~
## $ Pekerjaan     <int> 0, 1, 1, 0, 1, 1, 0, 0, 0, 1, 1, 1, 1, 0, 0, 1, 1, 1, 0,~
## $ Beli          <int> 1, 1, 1, 0, 1, 1, 1, 0, 1, 1, 1, 0, 0, 1, 1, 1, 1, 0, 1,~
# Konversi variabel menjadi faktor
data$Jenis_Kelamin <- as.factor(data$Jenis_Kelamin)
data$Pekerjaan <- as.factor(data$Pekerjaan)
data$Beli <- as.factor(data$Beli)
 glimpse(data)
## Rows: 100
## Columns: 3
## $ Jenis_Kelamin <fct> 0, 0, 0, 1, 0, 1, 1, 1, 0, 0, 1, 1, 1, 0, 1, 0, 1, 0, 0,~
## $ Pekerjaan     <fct> 0, 1, 1, 0, 1, 1, 0, 0, 0, 1, 1, 1, 1, 0, 0, 1, 1, 1, 0,~
## $ Beli          <fct> 1, 1, 1, 0, 1, 1, 1, 0, 1, 1, 1, 0, 0, 1, 1, 1, 1, 0, 1,~
# Ringkasan deskriptif
summary(data)
##  Jenis_Kelamin Pekerjaan Beli  
##  0:57          0:46      0:51  
##  1:43          1:54      1:49
plot_bar(data)


Membagi Data

# Membagi data menjadi dua bagian (90% pelatihan dan 10% pengujian)
set.seed(123)  # Untuk memastikan pembagian yang konsisten
split <- sample.split(data$Beli, SplitRatio = 0.9)
train_data <- subset(data, split == TRUE)
test_data <- subset(data, split == FALSE)

Pemodelan Regresi Probit

# Pemodelan Regresi Probit
probit_model <- glm(Beli ~ Jenis_Kelamin + Pekerjaan, family = binomial(link = "probit"), data = train_data)

# Melihat ringkasan dari model yang dihasilkan
summary(probit_model)
## 
## Call:
## glm(formula = Beli ~ Jenis_Kelamin + Pekerjaan, family = binomial(link = "probit"), 
##     data = train_data)
## 
## Coefficients:
##                Estimate Std. Error z value Pr(>|z|)
## (Intercept)     0.08787    0.21921   0.401    0.689
## Jenis_Kelamin1 -0.35850    0.27050  -1.325    0.185
## Pekerjaan1      0.06006    0.26587   0.226    0.821
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 124.72  on 89  degrees of freedom
## Residual deviance: 122.91  on 87  degrees of freedom
## AIC: 128.91
## 
## Number of Fisher Scoring iterations: 3

Interpretasi Model

# Interpretasi koefisien
coef(probit_model)
##    (Intercept) Jenis_Kelamin1     Pekerjaan1 
##     0.08786861    -0.35849655     0.06006332

Hasil nilai penduga \(β_1=-0.35849655\) berarti bahwa pelanggan perempuan memiliki probabilitas lebih rendah untuk membeli produk dibandingkan dengan pelanggan laki-laki. Penurunan ini setara dengan \(Z-score\) sebesar \(0.35849655\) lebih rendah untuk pelanggan perempuan dibandingkan dengan pelanggan laki-laki.
Hasil nilai penduga \(β_2=0.06006332\) berarti bahwa pelanggan yang bekerja memiliki probabilitas lebih tinggi untuk membeli produk dibandingkan dengan pelanggan yang tidak bekerja. Peningkatan ini setara dengan \(Z-score\) sebesar \(0.06006332\) lebih tinggi untuk pelanggan yang bekerja dibandingkan dengan yang tidak bekerja.
Evaluasi Model

# Pengecekan Model dengan Data Pengujian
# Prediksi probabilitas membeli dengan data pengujian
predictions <- predict(probit_model, newdata = test_data, type = "response")
# Mengonversi probabilitas menjadi kelas (0 atau 1, dengan threshold 0.5)
predicted_class <- ifelse(predictions > 0.5, 1, 0)

# Membuat confusion matrix untuk melihat akurasi prediksi
test_data$Beli <- as.factor(test_data$Beli)
conf.mat <- confusionMatrix(as.factor(predicted_class), test_data$Beli)

Interpretasi hasil Conf.mat: Hasil confusion matrix menunjukkan bahwa model regresi Probit yang diperoleh memiliki persentase pengamatan (aktual) yang diprediksi dengan benar oleh model sebesar 70 persen. Persentase dari kelas 0 (aktual) yang diprediksi dengan benar oleh model adalah sebesar 80 persen, sementara persentase dari kelas 1 (aktual) yang diprediksi dengan benar oleh model adalah sebesar 60 persen, dengan accuracy keseluruhan sebesar 70 persen. Model ini dinilai cukup baik dalam memprediksi keputusan pembelian pelanggan, berdasarkan hasil balanced accuracy sebesar 70 persen.

tidy(conf.mat)
## # A tibble: 14 x 6
##    term                 class estimate conf.low conf.high p.value
##    <chr>                <chr>    <dbl>    <dbl>     <dbl>   <dbl>
##  1 accuracy             <NA>     0.7      0.348     0.933   0.172
##  2 kappa                <NA>     0.4     NA        NA      NA    
##  3 mcnemar              <NA>    NA       NA        NA       1    
##  4 sensitivity          0        0.8     NA        NA      NA    
##  5 specificity          0        0.6     NA        NA      NA    
##  6 pos_pred_value       0        0.667   NA        NA      NA    
##  7 neg_pred_value       0        0.75    NA        NA      NA    
##  8 precision            0        0.667   NA        NA      NA    
##  9 recall               0        0.8     NA        NA      NA    
## 10 f1                   0        0.727   NA        NA      NA    
## 11 prevalence           0        0.5     NA        NA      NA    
## 12 detection_rate       0        0.4     NA        NA      NA    
## 13 detection_prevalence 0        0.6     NA        NA      NA    
## 14 balanced_accuracy    0        0.7     NA        NA      NA
Receiver Operating Characteristics (ROC) Curve

Receiver Operating Characteristics (ROC) curve melacak persentase true positive saat cut-off peluang prediksi diturunkan dari 1 menjadi 0. Model yang baik akan memperlihat kurva yang lebih curam, artinya True Positive Rate meningkat lebih cepat dibandingkan dengan False Positive Rate ketika cut-off menurun. Dengan kata lain, semakin besar luas area di bawah kurva ROC maka kemampuan prediksi yang dihasilkan oleh model semakin baik.

# Install package pROC jika belum terinstal
# install.packages("pROC")

# Load library
library(pROC)

actual <- test_data$Beli == "1"  # Status Pra Sekolah: TRUE untuk kelas 1, FALSE untuk kelas 0
predicted <- predictions  # Prediksi probabilitas dari model
# Membuat ROC Curve
roc_curve <- roc(actual, predicted)
## Setting levels: control = FALSE, case = TRUE
## Setting direction: controls < cases
# Plot ROC Curve
plot(roc_curve, main="ROC Curve", col="blue", lwd=3)

# Menghitung AUC (Area Under the Curve)
auc_value <- auc(roc_curve)
print(paste("AUC: ", auc_value))
## [1] "AUC:  0.66"
# Menghitung akurasi model
accuracy <- mean(predicted_class == test_data$Beli)
print(paste("Akurasi model:", accuracy))
## [1] "Akurasi model: 0.7"

Semakin mendekati 1, semakin baik model dalam membedakan antara kelas positif dan negatif. Namun, dengan \(AUC\) sebesar \(0.66\), model masih dapat ditingkatkan untuk meningkatkan akurasi prediksi dalam memisahkan antara kelas positif dan negatif secara lebih jelas.

Untuk Latihan silahkan gunakan yang ada pada modul kawan-kawan yaaa