Prediksi Turn-over karyawan
ASWIN JANUARSJAF
6 November 2020
Karyawan adalah Aset yang bernilai
Karyawan adalah Aset yang sangat penting bagi organisasi, ketika ia keluar/Termination maka kita akan kehilangan nilai-nilai substansial yang dia miliki, apalagi bila ia adalah seorang yang memiliki talenta tinggi sebagai calon pimpinan masa depan.
Bagaimana HR Analytics melakukan Prediksi
Tujuan dari tulisan ini adalah untuk memberikan panduan dasar yang dapat Anda gunakan untuk memprediksi karyawan yang Termination/keluar. Juga akan disampaikan cara manipulasi, analisis, dan visualisasi data.
Memprediski karyawan dengan HR Analytics
Ada tiga tahap yang akan kita pelajari:
1: Bagaimana mengidentifikasi berbagai variabel karyawan menggunakan teknik dasar statistik deskriptif.
Bagaimana membangun model prediktif menggunakan beberapa model prediktif sederhana.
Bagaimana mengukur akurasi model.
Penjelasan Tambahan:
Asumsinya kita ingin mengetahui atau mampu memprediksi karyawan yang akan Termination atau keluar di tahun depan. Pada data ini variabel tersebut diberi nama “resign” (0=tinggal, 1=keluar).
Bersihkan dulu memori pada komputer Anda
rm(list = ls())Library yang digunakan
library(plyr)
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:plyr':
##
## arrange, count, desc, failwith, id, mutate, rename, summarise,
## summarize## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(ggplot2)
library(caTools) # splitting sample
library(ROCR) # pengukuran ROC/ AUC
library(pROC) # pengukuran ROC/ AUC## Type 'citation("pROC")' for a citation.##
## Attaching package: 'pROC'## The following objects are masked from 'package:stats':
##
## cov, smooth, varlibrary(rattle) # visualisasi model prediktif## Loading required package: tibble## Loading required package: bitops## Rattle: A free graphical interface for data science with R.
## Version 5.4.0 Copyright (c) 2006-2020 Togaware Pty Ltd.
## Type 'rattle()' to shake, rattle, and roll your data.library(rpart.plot)## Loading required package: rpartlibrary(RColorBrewer)
library(psych) # untuk korelasi biserial##
## Attaching package: 'psych'## The following objects are masked from 'package:ggplot2':
##
## %+%, alphasetwd("D:/R/hranalytics/Rmd")
d <- read.csv("turnoverdata.csv",header=TRUE,sep=";")Data eksplorasi dan visualisasi
dim(d) # jumlah data## [1] 11111 11colnames(d) # nama-nama variabel## [1] "posisi" "kinerja" "area" "jeniskelamin" "id"
## [6] "usia" "gaji" "gma" "resign" "X"
## [11] "X.1"summary(d)## posisi kinerja area jeniskelamin
## CEO : 1 Min. :1.000 Accounting:1609 Pria :5043
## Direktur: 100 1st Qu.:2.000 Finance :1677 Wanita:6068
## Manajer : 1000 Median :2.000 Marketing :2258
## Staf :10000 Mean :2.198 Other :2198
## VP : 10 3rd Qu.:3.000 Sales :3369
## Max. :3.000
## id usia gaji gma
## Min. : 1 Min. :22.0 Min. : 44640 Min. :1.000
## 1st Qu.: 2778 1st Qu.:24.0 1st Qu.: 5460469 1st Qu.:1.000
## Median : 5556 Median :25.0 Median : 5944655 Median :2.000
## Mean : 5556 Mean :27.3 Mean : 6055991 Mean :1.994
## 3rd Qu.: 8334 3rd Qu.:28.0 3rd Qu.: 6362488 3rd Qu.:3.000
## Max. :11111 Max. :62.0 Max. :46671077 Max. :3.000
## resign X X.1
## Min. :0.0000 Mode:logical Mode:logical
## 1st Qu.:0.0000 NA's:11111 NA's:11111
## Median :0.0000
## Mean :0.3812
## 3rd Qu.:1.0000
## Max. :1.0000dari data diatas kita mengetahui ada 5 posisi: CEO, VP, Direktur, Manajer dan Staf. Kita akan menghapus posisi CEO dan VP karena tidak signifikan dalam pembuatan model dalam data ini. Let’s filter them out.
d <- filter(d, posisi == "Staf" | posisi == "Manajer" | posisi == "Direktur")
d$posisi <- factor(d$posisi) # setting ulang posisi
summary(d)## posisi kinerja area jeniskelamin
## Direktur: 100 Min. :1.000 Accounting:1607 Pria :5036
## Manajer : 1000 1st Qu.:2.000 Finance :1676 Wanita:6064
## Staf :10000 Median :2.000 Marketing :2255
## Mean :2.198 Other :2197
## 3rd Qu.:3.000 Sales :3365
## Max. :3.000
## id usia gaji gma
## Min. : 12 Min. :22.00 Min. : 44640 Min. :1.000
## 1st Qu.: 2787 1st Qu.:24.00 1st Qu.: 5461877 1st Qu.:1.000
## Median : 5562 Median :25.00 Median : 5945582 Median :2.000
## Mean : 5562 Mean :27.27 Mean : 6057675 Mean :1.994
## 3rd Qu.: 8336 3rd Qu.:28.00 3rd Qu.: 6362881 3rd Qu.:3.000
## Max. :11111 Max. :61.00 Max. :46671077 Max. :3.000
## resign X X.1
## Min. :0.0000 Mode:logical Mode:logical
## 1st Qu.:0.0000 NA's:11100 NA's:11100
## Median :0.0000
## Mean :0.3815
## 3rd Qu.:1.0000
## Max. :1.0000Kinerja
Pertama kali kita lihat Kinerja, kriterianya 1 = low, 2 = mid, 3 = high
Setting warna
cbPalette <- c("#999999", "#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7")table(d$kinerja)##
## 1 2 3
## 1117 6667 3316hist(d$kinerja, col = cbPalette[4], main = "Distribusi Rangking Kinerja",
xlab = "Kinerja", ylab = "# Karyawan" )
Dari hisogram diatas kita bisa melihat distribusinya, dengan hanya 3 distribusi nilai, kita tidak bisa menganalisa berdasarkan distribusi normal atau kemiringan kurva.
Kita harus menggunakan fungsi aggregate untuk membuat tabel probabilitas kelompok kinerja, kita lihat tingkat turnover/ keluar tertinggi ada pada karyawan yang memiliki kinerja tinggi.
Ini adalah masalah besar!
agg_perf <- aggregate(resign ~ kinerja, data = d, mean)
print(agg_perf)## kinerja resign
## 1 1 0.3375112
## 2 2 0.3383831
## 3 3 0.4831122ggplot(agg_perf, aes(x = kinerja, y = resign)) + geom_bar(stat = "identity", fill = cbPalette[3]) +
ggtitle("Tingkat Terminasi Karyawan berdasarkan Kinerja") +
labs (y = "Probabilitas resign", x = "Nilai Kinerja")
Area Bisnis dan Jenis Kelamin
Kita lakukan analisis yang sama untuk Area Bisnis dan Jenis Kelamin.
Jenis Kelamin
agg_sex <- aggregate(resign ~ jeniskelamin, data = d, mean)
print(agg_sex)## jeniskelamin resign
## 1 Pria 0.2781970
## 2 Wanita 0.4673483ggplot(agg_sex, aes(x = jeniskelamin, y = resign)) + geom_bar(stat = "identity", fill = cbPalette[3]) +
ggtitle("Tingkat Terminasi Karyawan berdasarkan Jenis Kelamin") +
labs (y = "Probabilitas resign", x = "Jenis Kelamin")
Perhatikan prosentase yang akan keluar lebih banyak wanita dibandingkan pria.
Area Bisnis
agg_area <- aggregate(resign ~ area, data = d, mean)
print(agg_area)## area resign
## 1 Accounting 0.3055383
## 2 Finance 0.3126492
## 3 Marketing 0.2815965
## 4 Other 0.3040510
## 5 Sales 0.5696880ggplot(agg_area, aes(x = area, y = resign)) + geom_bar(stat = "identity", fill = cbPalette[3]) +
ggtitle("Tingkat Terminasi Karyawan berdasarkan Area Bisnis") +
labs (y = "Probabilitas resign", x = "Area Bisnis")
Prosentase terbesar karyawan yang akan keluar adalah dari bagian Sales.
Apakah ada perbedaan antara pria dan wanita dalam bisnis area tertentu?
agg_as <- aggregate(resign ~ area + jeniskelamin, data = d, mean)
print(agg_as)## area jeniskelamin resign
## 1 Accounting Pria 0.1986111
## 2 Finance Pria 0.2168200
## 3 Marketing Pria 0.1785714
## 4 Other Pria 0.2071066
## 5 Sales Pria 0.4589309
## 6 Accounting Wanita 0.3923337
## 7 Finance Wanita 0.3923497
## 8 Marketing Wanita 0.3691550
## 9 Other Wanita 0.3828383
## 10 Sales Wanita 0.6624795ind <- order(agg_as$area, agg_as$jeniskelamin) #reordering so make comparisons easier
print(agg_as[ind,])## area jeniskelamin resign
## 1 Accounting Pria 0.1986111
## 6 Accounting Wanita 0.3923337
## 2 Finance Pria 0.2168200
## 7 Finance Wanita 0.3923497
## 3 Marketing Pria 0.1785714
## 8 Marketing Wanita 0.3691550
## 4 Other Pria 0.2071066
## 9 Other Wanita 0.3828383
## 5 Sales Pria 0.4589309
## 10 Sales Wanita 0.6624795Pada grafik yang terdiri dari dua plot, kita bisa melihat ada sedikit perbedaan untuk wanita di kelompok sales dengan kelompok pria.
ggplot(agg_as, aes(x = area, y = resign, fill = jeniskelamin)) +
geom_bar(aes(fill = jeniskelamin), stat = "identity", position=position_dodge()) +
scale_fill_manual(values=cbPalette[3:4]) +
ggtitle("Tingkat Terminasi Karyawan berdasarkan Area Bisnis") +
labs (y = "Probabilitas resign", x = "Area Bisnis")
Usia
Sekarang mari kita lihat distribusi usia karyawan
hist(d$usia, breaks = 100, col = cbPalette[3], main = "Distribusi Usia", border = F, xlab = "Usia")
quantile(d$usia)## 0% 25% 50% 75% 100%
## 22 24 25 28 61Terjadi kemiringan kekanan (positive skewness), sekitar 50% karyawan berusia antara 22 dan 26 tahun.
Akan lebih informatif bila kita menggunakan boxplot, untuk menampilkan median pada masing-masing posisi (staf, manajer, direktur).
d$posisi <- factor(d$posisi, levels = c("Staf", "Manajer", "Direktur")) # mengurutkan posisi
boxplot(usia ~ posisi, data = d, col= cbPalette[3])
Dengan melihat boxplot kita mengetahui terdapat perbedaan yang sangat besar antara usia dan posisi. Artinya terdapat hubungan yang kuat antara usia dan posisi.
Agar lebih memudahkan perhitungan sebaiknya kita konversi data usia menggunakan fungsi log, hal ini dikenal dengan Transformasi Data biasa dilakukan untuk membuat continuous distribution.
d$log_age <- log(d$usia)ini artinya, mari kita merinci tingkat terminasi berdasarkan posisi dan usia.
agg_role <- aggregate(resign ~ posisi, data = d, mean)
print(agg_role)## posisi resign
## 1 Staf 0.3749
## 2 Manajer 0.4580
## 3 Direktur 0.2800ggplot(agg_role, aes(x = posisi, y = resign)) +
geom_bar(stat = "identity", fill = cbPalette[3], width = .7) +
ggtitle("Tingkat Terminasi Karyawan berdasarkan Posisi") +
labs (y = "Probabilitas resign", x = "posisi") 
Kita dapat mengetahui para Manajer tampaknya lebih banyak yang akan Resign.
Mari kita pilah rentang usia menjadi 10 kelompok.
agg_age <- aggregate(x = d$resign, by = list(cut(d$usia, 10)), mean)
print(agg_age)## Group.1 x
## 1 (22,25.9] 0.3865112
## 2 (25.9,29.8] 0.3655738
## 3 (29.8,33.7] 0.3337438
## 4 (33.7,37.6] 0.4119850
## 5 (37.6,41.5] 0.4119601
## 6 (41.5,45.4] 0.4471831
## 7 (45.4,49.3] 0.4420601
## 8 (49.3,53.2] 0.4495413
## 9 (53.2,57.1] 0.4333333
## 10 (57.1,61] 0.2222222names(agg_age) <- c("usia", "Probability")
ggplot(agg_age, aes(x = usia, y = Probability)) +
geom_bar(stat = "identity", fill = cbPalette[3], width = .7) +
ggtitle("Tingkat Terminasi Karyawan berdasarkan Posisi dan Usia") +
labs(y = "Probabilitas resign", x = "Kelompok Usia") 
Dari Grafik terlihat terjadi peningkatan tingkat terminasi pada usia antara 34 dan 46, dan juga kenaikan hingga usia hingga 58.
Salary/Gaji
summary(d$gaji)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 44640 5461877 5945582 6057675 6362881 46671077aggregate(gaji ~ posisi, data = d, mean)## posisi gaji
## 1 Staf 5465615
## 2 Manajer 9900922
## 3 Direktur 26831147boxplot(gaji ~ posisi, data = d, col = cbPalette[3], main = "Gaji berdasarkan Posisi")
Gaji para direkturnya berada jauh daripada gaji para Manajer. Hal ini juga merupakan salah satu indikasi penting dalam melakukan analisis tentang karyawan yang Resign.
Pemisahan Data (Data Splitting)
Sebelum membuat model, kita harus memisahkan data menjadi dua: data training set dan data tes. Data training set digunakan untuk membuat model, sedangkan data tes digunakan untuk menguji akurasi model tadi.
Ingat, tujuan dari model prediktif adalah untuk memprediksi hasil yang terjadi.
Dalam kasus ini, kita menggunakan 2/3 dari data untuk membuat model, 1/3 data untuk melakukan pengetesan terhadap model.
set.seed(42) # setting the random seed for replication
spl <- sample.split(d$resign, 2/3)
train <- d[spl,]
test <- d[!spl,]# Cek proporsi resign test dan training
mean(test$resign)## [1] 0.3816216mean(train$resign)## [1] 0.3814865Pengantar tentang Perhitungan Model Prediksi
Kita menggunakan dua model prediksi: Logistic Regression dan Decision Tree.
LOGISTIC REGRESSION MODEL
Kita akan menggunakan fungsi gml (general linear model) untuk membuat model regresi logistik.
m1 <- glm(resign ~ kinerja+ posisi + log_age + jeniskelamin +gma+ area + jeniskelamin*area, data = train, family = 'binomial')
summary(m1) # tampilkan hasil model##
## Call:
## glm(formula = resign ~ kinerja + posisi + log_age + jeniskelamin +
## gma + area + jeniskelamin * area, family = "binomial", data = train)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.8377 -0.9414 -0.6348 1.1210 2.2460
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.63971 0.78451 -0.815 0.4148
## kinerja 0.44592 0.04330 10.298 < 2e-16 ***
## posisiManajer 0.64096 0.14817 4.326 1.52e-05 ***
## posisiDirektur 0.08446 0.33831 0.250 0.8028
## log_age -0.59515 0.23753 -2.506 0.0122 *
## jeniskelaminWanita 1.12753 0.14510 7.771 7.79e-15 ***
## gma 0.01087 0.03128 0.347 0.7282
## areaFinance 0.21502 0.15949 1.348 0.1776
## areaMarketing 0.09022 0.15132 0.596 0.5510
## areaOther 0.17650 0.15234 1.159 0.2466
## areaSales 1.39781 0.13352 10.469 < 2e-16 ***
## jeniskelaminWanita:areaFinance -0.29481 0.19977 -1.476 0.1400
## jeniskelaminWanita:areaMarketing -0.14926 0.18804 -0.794 0.4273
## jeniskelaminWanita:areaOther -0.37662 0.18969 -1.985 0.0471 *
## jeniskelaminWanita:areaSales -0.26907 0.16999 -1.583 0.1134
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 9838.8 on 7399 degrees of freedom
## Residual deviance: 8901.3 on 7385 degrees of freedom
## AIC: 8931.3
##
## Number of Fisher Scoring iterations: 4Waw… Apakah artinya itu semua? Mari kita lihat fokus pada hal-hal penting.
Seluruh variabel prediktor yang dianalisis tertera dibawah judul “Coefficients”.
Nilai signifikan dapat kita lihat apabila terdapat perbedaan yang signifikan antara z value dan (Pr>|z|).
Perbedaan jarak (range) yang jauh antara Nilai (Pr>|z|) dengan nilai z value menunjukkan bahwa variabel tersebut adalah penting untuk dijadikan prediktor mengapa karyawan tersebut keluar/resign.
Kesimpulan yang dapat diambil…
Posisi Manajer kebanyakan akan resign namun posisi Direktur tidak menunjukkan hal tersebut (variabel: posisiManajer).
Dari variabel usia yang sudah ditransformasi menjadi log_age menghasilkan nilai negatif, artinya karyawan yang dengan usia lebih tua cenderung enggan untuk resign (variabel: log_age).
Jenis kelamin wanita lebih banyak yang resign. (variabel:jeniskelaminWanita).
Area bisnis yang berada di bagian Sales menunjukkan probabilitas yang tinggi untuk resign (variabel: areaSales).
Wanita di area other juga menunjukkan sigifikansi kecenderungan untuk resign. **(variabel:jeniskelaminWanita:areaOther)
FINAL LOGISTIC REGRESSION MODEL
m2 <- glm(resign ~ kinerja + posisi + log_age + jeniskelamin + area , data = train, family = 'binomial')
summary(m2) # tampilkan hasil model##
## Call:
## glm(formula = resign ~ kinerja + posisi + log_age + jeniskelamin +
## area, family = "binomial", data = train)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.8453 -0.9337 -0.6381 1.1219 2.1722
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.46743 0.77600 -0.602 0.5469
## kinerja 0.44410 0.04326 10.266 < 2e-16 ***
## posisiManajer 0.64221 0.14810 4.336 1.45e-05 ***
## posisiDirektur 0.09897 0.33838 0.292 0.7699
## log_age -0.59402 0.23743 -2.502 0.0124 *
## jeniskelaminWanita 0.89410 0.05251 17.026 < 2e-16 ***
## areaFinance 0.02641 0.09555 0.276 0.7823
## areaMarketing -0.00725 0.08915 -0.081 0.9352
## areaOther -0.06511 0.09037 -0.720 0.4713
## areaSales 1.22893 0.08169 15.044 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 9838.8 on 7399 degrees of freedom
## Residual deviance: 8906.3 on 7390 degrees of freedom
## AIC: 8926.3
##
## Number of Fisher Scoring iterations: 4hist(m2$fitted.values, main = "Distribution of Predicted Probabilities",
xlab = "Probability of Leaving", col = cbPalette[4], border = F, breaks = 50)
abline(v = .5, col = "red", lwd = 3)
prop.table(table(m2$fitted.values >= .5))##
## FALSE TRUE
## 0.7791892 0.2208108prop.table(table(m2$fitted.values >= .3))##
## FALSE TRUE
## 0.3516216 0.6483784Dari histogram (dan kalkulasi) training data menghasilkan bahwa sekitar 22% dari karyawan memiliki peluang untuk keluar sekitar 50% atau lebih.
65% dari karyawan memiliki peluang untuk keluar lebih besar dari 30%.
Sekarang kita harus menghitungnya pada data tes.
Mengukur Akurasi Model
Untuk mengetahui seberapa akurat model yang dihasilkan untuk memprediski karyawan yang keluar / resign, pertama-tama kita harus menggunakan model untuk memprediksi data-data yang ada di data tes, yaitu data yang telah kita pisahkan tadi.
m2_test <- predict(m2, newdata = test, type = "response")
hist(m2_test, main = "Distribution of Test Set \nPredicted Probabilities",
xlab = "Probability of Leaving", col = cbPalette[3], border = F, breaks = 50)
abline(v = .5, col = "red", lwd = 3)
prop.table(table(m2_test >= .5))##
## FALSE TRUE
## 0.7778378 0.2221622prop.table(table(m2_test>= .3))##
## FALSE TRUE
## 0.3354054 0.6645946Dari histogram (dan kalkulasi) training data menghasilkan bahwa sekitar 22% dari karyawan memiliki peluang untuk keluar sekitar 50% atau lebih.
66% dari karyawan memiliki peluang untuk keluar lebih besar dari 30%.
Confusion Matrix
Kita menggunakan “confusion matrix” untuk membandingkan hasil observasi dari data tes dengan hasil prediktif.
Kita akan gunakan cutoff .5 sehingga bila ada karyawan yang nilainya lebih dari .5 dikategorikan karyawan yang keluar.
prop.table(table(test$resign))##
## 0 1
## 0.6183784 0.3816216accuracy <- table(m2_test > .5, test$resign) # confusion matrix
addmargins(table(m2_test > .5, test$resign))##
## 0 1 Sum
## FALSE 1982 896 2878
## TRUE 306 516 822
## Sum 2288 1412 3700Nilai pada kolom menunjukkan hasil prediksinya (predicted outcomes), dimana False = 0 dan True = 1. Nilai-nilai pada kolom menunjukkan nilai yang sebenarnya (observed outcomes).
Hasil pengukuran akurasi model didapatkan dengan menjumlahkan kedua nilai yang benar secara diagonal dibagi total jumlah observasi. Ini akan memberikan proporsi akurasinya.
sum(diag(accuracy))/sum(accuracy)## [1] 0.6751351Hasilnya adalah 67,5% akurat, bukan sesuatu yang spektakuler tapi lebih baik dari pada tidak ada sama sekali.
Kurva ROC
ROC (“Receiver Operating Characteristic”) pertama kali digunakan pada perang dunia kedua untuk membantu proses deteksi pada radar. Saat ini digunakan untuk penelitian tentang kognisi manusia, radiologi, epidemiologi, dan model-model prediktif lainnya.
Kurva ROC membantu kita memvisualisasikan perbedaan antara nilai True Positive dan False Positive.
# collector for the data that we will plot
rates <- data.frame(fp = numeric(3), tp = numeric(3), cutoff = as.numeric(3))
for (i in 1:3){ # cycling through the middle cutoff values to test
temp_cutoffs <- c(.3, .5, .7)
# accuracy <- table(m2_test > i, test$vol_leave) # confusion matrix
temp_res <- addmargins(table(m2_test > temp_cutoffs[i], test$resign))
rates$fp[i] <- temp_res[2,1]/temp_res[3,1]
rates$tp[i] <- temp_res[2,2]/temp_res[3,2]
rates$cutoff[i] <- temp_cutoffs[i]
}
# plotting the calculated rates
plot(rates$fp[1:3], rates$tp[1:3], pch = 19, col = "red", cex = 1.5,
xlim = c(0,1), ylim = c(0,1), xlab = "False Positive Rate",
ylab = "True Positive Rate",
main = "False Positive and True Positive Rates \nFor Different Cutoffs")
# Lines connecting the dots
lines(c(0, rates$fp[3:1], 1), c(0,rates$tp[3:1],1),
xlim = c(0,1), ylim = c(0,1))
# Additional notes for the figure
abline(coef = c(0,1), col = "black", lwd = 2)
points(x = c(0,1), y = c(0,1),pch = 19, col = "red", cex = 1.5)
points(x = 0, y = 1, pch = 19, col = "dark green", cex = 1.5)
text(x = rates$fp, y = (rates$tp + .05), labels = rates$cutoff)
text(x = .07, y = .97, labels = "Ideal Model")
text(x = 0, y = .05, labels = 1)
text(x = 1, y = .95, labels = 0)
abline(v = 0, h = 1, lty = 2, lwd = 2)
text(.5, .46, srt = 30, labels = "No Predictive Power")
Logistic Regression ROC Curve
opt.cut <- function(perf, pred){
cut.ind <- mapply(FUN=function(x, y, p){
d <- (x - 0)^2 + (y-1)^2
ind <- which(d == min(d))
c(sensitivity = y[[ind]], specificity = 1-x[[ind]],
cutoff = p[[ind]])
}, perf@x.values, perf@y.values, pred@cutoffs)
}
# Function for the ROC Curve: http://rocr.bioinf.mpi-sb.mpg.de/
visROC <- function(model, data, outcome){
# Core three steps from ROCR
temp_pred <- predict(model, newdata= data, type = "response")
roc_pred <- prediction(temp_pred, data[,outcome]) #create an s4 ROC object
roc_perf <- performance(roc_pred, "tpr", "fpr")
# make the plot
plot(roc_perf, colorize = TRUE, print.cutoffs.at = seq(0,1,.1),
main = "ROC Curve", lwd = 2)
abline(coef = c(0,1), col = "black", lwd = 2)
# get the optimum cutoff
opt <- opt.cut(roc_perf, roc_pred)
points(x = 1-opt[2], y = opt[1], pch = 19, col = "red", cex = 1.5)
text(x = 1-opt[2], y = opt[1] + .05, labels = "Optimum Cutoff")
# Area Under the Curve
text(x = .6, y = .3, label = paste("Area Under the Curve:\n",
round(as.numeric(performance(roc_pred, "auc")@y.values), 2)))
text(x = .6, y = .15, label = paste("Optimum Cutoff:\n", round(opt[3],3)))
}
# Running the functions
visROC(m2, test, "resign") 
BORUTA
Boruta adalah algoritma dari random forestclassification. Boruta mencoba untuk menangkap variabel-variabel penting, yang memiliki pengaruh signifikan dalam memprediksi tujuan ingin diketahui.
library(Boruta)## Loading required package: ranger##
## Attaching package: 'ranger'## The following object is masked from 'package:rattle':
##
## importancecolnames(d)## [1] "posisi" "kinerja" "area" "jeniskelamin" "id"
## [6] "usia" "gaji" "gma" "resign" "X"
## [11] "X.1" "log_age"data<-data.frame(d[,1:9])
colnames(data)## [1] "posisi" "kinerja" "area" "jeniskelamin" "id"
## [6] "usia" "gaji" "gma" "resign"fit<-Boruta(resign~.,data,doTrace = 2)## 1. run of importance source...## 2. run of importance source...## 3. run of importance source...## 4. run of importance source...## 5. run of importance source...## 6. run of importance source...## 7. run of importance source...## 8. run of importance source...## 9. run of importance source...## 10. run of importance source...## After 10 iterations, +1.2 mins:## confirmed 7 attributes: area, gaji, id, jeniskelamin, kinerja and 2 more;## rejected 1 attribute: gma;## no more attributes left.print(fit)## Boruta performed 10 iterations in 1.229902 mins.
## 7 attributes confirmed important: area, gaji, id, jeniskelamin,
## kinerja and 2 more;
## 1 attributes confirmed unimportant: gma;plot(fit, xlab = "", xaxt = "n")
lz<-lapply(1:ncol(fit$ImpHistory),function(i)
fit$ImpHistory[is.finite(fit$ImpHistory[,i]),i])
names(lz) <- colnames(fit$ImpHistory)
Labels <- sort(sapply(lz,median))
axis(side = 1,las=2,labels = names(Labels),
at = 1:ncol(fit$ImpHistory), cex.axis = 0.7)
Variabel-variabel yang penting dalam memprediksi karyawan yang keluar adalah: area, gaji, jeniskelamin, kinerja.
Semoga bermanfaat.