Era industri 4.0 dimulai saat pemerintah Jerman menggunakan istilah ini pada tahun 2011 yang bertujuan untuk memajukan industri dengan bantuan teknologi. Revolusi industri generasi keempat bisa diartikan sebagai adanya ikut campur sebuah sistem cerdas dan otomasi dalam industri. Hal ini digerakkan oleh data melalui teknologi machine learning dan kecerdasan buatan [1]. Selama tahun 2023, kecerdasan buatan mendapat tempat lebih dengan semakin masif nya penggunaan kecerdasan buatan pada berbagai sektor industri. Meledaknya penggunaan kecerdasan buatan generatif pada tahun 2023 menunjukkan besaran potensi pasar yang dihasilkan teknologi tersebut. Laporan dari Deloitte pada Desember 2023 memprediksi bahwa generatif AI masih akan tetap mendominasi lanskap digital setahun mendatang [2].
Era digital telah mengubah lanskap bisnis secara signifikan,
mendorong perusahaan untuk beradaptasi dengan teknologi dan tren
terkini. Transformasi digital bukan hanya menjadi pilihan, tetapi suatu
keharusan agar perusahaan dapat bersaing dan berkembang di tengah
persaingan yang semakin ketat [3].
Dalam hal ini, bidang marketing pun ikut berubah seiring dengan
berubahnya lanskap bisnis. Strategi pemasaran saat ini banyak
memanfaatkan platform digital seperti situs web, media sosial, dan email
untuk berinteraksi dengan pelanggan. Ini mencakup berbagai teknik
seperti pemasaran konten, SEO, dan pemasaran media sosial [4].
Bahkan pakar pemasaran terkemuka, Philip Kotler, mengenalkan marketing 6.0. Marketing 6.0 ini merupakan revolusi pemasaran yang mencerminkan pergeseran signifikan dalam lanskap digital dan ekonomi global. Konsep marketing 6.0 ini menekankan pada pembangunan merek yang kuat, optimalisasi pemasaran digital, dan prioritas pada pengalaman pelanggan. Konsep ini juga memberikan peluang bagi bisnis skala kecil dan menengah untuk bersaing secara efektif di era digital. Namun penerapan marketing 6.0 membutuhkan transformasi digital dan strategi pemasaran yang terintegrasi. Berikut perbedaan marketing konvensional dan marketing 6.0 [5].
Tidak hanya model bisnis yang berubah, tapi perilaku konsumen pun turut berubah seiring dengan semakin masif penggunaan teknologi saat ini. Kemudahan dalam beraktifitas dan melakukan transaksi tidak hanya mempengaruhi model bisnis dan perilaku konsumen, tapi juga membuat persaingan menjadi lebih ketat. Bahkan saat ini siapa pun bisa menjadi marketer dan bisa memasarkan produk apa saja [5].
Tantangan lainnya bagi para marketer yaitu perubahan algoritma yang cepat pada berbagai platform, pengukuran ROI yang rumit terutama pada kampanye multichannel, kesulitan dalam menjangkau audiens yang tepat, biaya iklan yang semakin tinggi akibat dari kompetisi yang semakin ketat, anggaran yang terbatas, kurangnya sdm, dan konten serta media yang kurang tepat [6][7][8].
Dalam penelitian yang dilakukan pada lebih dari 500 pengambil
keputusan pemasaran di Inggris, oleh perusahaan konten berbasis
pencarian, No
Brainer, dipaparkan bahwa permasalahan utama para eksekutif
pemasaran di tahun 2024, yaitu:
- Peningkatan dan volatilitas mesin pencari
- Keterampilan dan peningkatan keterampilan internal
- Kecemasan akan digantikan oleh AI
- Mendapatkan liputan media yang relevan dengan target klien
- Atribusi & ROI
- Mempertahankan dan meningkatkan visibilitas dalam pencarian
- Kurangnya pengetahuan tentang bagaimana kita dapat menggunakan
AI
- Aktivitas pasar dan pesaing
- Integrasi tim untuk menawarkan pemasaran terintegrasi/omnichannel [9].
Dari tantangan tersebut tentunya para marketer tidak bisa lagi mengolah data secara manual untuk membuat keputusan dalam hal strategi marketing, seperti menentukan persona target konsumen, menentukan akan membuat kampanye yang seperti apa, dan pada platform mana yang sesuai dengan budget serta mendapatkan konversi yang optimal. Para pelaku UMKM, pun yang biasanya merangkap juga sebagai marketer untuk produk mereka, juga mengalami hal yang sama. Terlebih bagi para pelaku UMKM, mereka dihadapkan pada sumber daya marketing yang terbatas dan sulitnya membangun brand image yang kuat untuk dapat bersaing dengan kompetitor. Hal ini terbukti dari survey dari MSME Empowerment yang menunjukkan bahwa sebanyak 70% UMKM yang kesulitan dalam memasarkan produknya [10].
Oleh karena itu pada proyek ini akan dibuat sebuah model untuk memprediksi keputusan pembelian konsumen dan click-trough rate (CTR) berdasarkan data demografi, variabel marketing, variabel customer engagement dan historical data pelanggan. Output proyek ini akan sangat bermanfaat bagi para marketer atau pun pelaku UMKM agar dapat menghemat waktu dalam membuat keputusan akan membuat konten yang seperti apa dengan estimasi biaya berapa dengan nilai CTR optimum.
Untuk memprediksi keputusan pembelian konsumen, biasanya para marketer hanya melihat dari data-data historis dan memprediksi secara manual. Sedangkan click-through rate (CTR) adalah jumlah klik yang diterima iklan dibagi dengan frekuensi iklan ditampilkan: klik ÷ tayangan = CTR. Data CTR ini akan diketahui dari masing-masing platform tempat iklan dibuat. Namun jika dilakukan secara manual, akan membutuhkan waktu yang lama. Sedangkan di era digital ini, para marketer maupun stakeholder perlu membuat keputusan marketing dalam waktu yang cepat. Jika tidak dilakukan dalam waktu yang cepat maka kondisi pun akan berubah dan faktor-faktor dalam pengambilan keputusan pun akan berubah. Hal ini menunjukkan bahwa sudah dibutuhkan bantuan teknologi dalam pengambilan keputusan. Selain itu juga mengingat besarnya error jika proses prediksi dilakukan secara manual. Pembuatan proyek ini juga akan sangat membantu para marketer di saat data yang dimiliki sudah semakin besar.
Pembuatan iklan ataupun konten marketing dapat lebih efektif dengan melakukan prediksi keputusan pembelian konsumen dan CTR. Oleh karena itu pada proyek ini akan dibuat model klasifikasi untuk mengidentifikasi apakah konsumen akan membeli atau tidak serta berapa besar CTR. Dengan prediksi ini diharapkan dapat mengoptimalkan biaya iklan dan proses pemilihan jenis konten, jenis iklan, dan channel iklan.
Model Consideration Customer purchasing decision prediction (klasifikasi) and CTR Prediction (regresi)
Linear Regression
Analisis regresi linier digunakan untuk memprediksi nilai suatu variabel
berdasarkan nilai variabel lain. Bentuk analisis ini memperkirakan
koefisien persamaan linier, yang melibatkan satu atau lebih variabel
independen yang paling baik memprediksi nilai variabel dependen. Regresi
linier menghasilkan garis lurus atau permukaan yang meminimalkan
perbedaan antara nilai keluaran yang diprediksi dan aktual. Model
regresi linier relatif sederhana dan menyediakan rumus matematika yang
mudah ditafsirkan yang dapat menghasilkan prediksi. Regresi linier dapat
diterapkan ke berbagai bidang dalam bisnis dan studi akademis [12].
Random Forest Classifier and Regressor
Random forest adalah algoritma pembelajaran mesin yang fleksibel dan
mudah digunakan yang menghasilkan, bahkan tanpa penyetelan
hiperparameter, hasil yang bagus hampir sepanjang waktu. Ini juga
merupakan salah satu algoritma yang paling banyak digunakan, karena
kesederhanaan dan keragamannya (dapat digunakan untuk tugas klasifikasi
dan regresi). Random forest juga merupakan algoritma yang sangat berguna
karena hiperparameter default yang digunakannya sering kali menghasilkan
hasil prediksi yang baik. Memahami hiperparameter cukup mudah, dan
jumlahnya juga tidak banyak. Salah satu masalah terbesar dalam
pembelajaran mesin adalah overfitting, tetapi sebagian besar waktu ini
tidak akan terjadi berkat pengklasifikasi random forest. Jika ada cukup
banyak pohon di hutan, pengklasifikasi tidak akan melakukan overfitting
pada model [13]
Naive Bayes Classifier
Klasifikasi Naïve Bayes merupakan kumpulan algoritma klasifikasi yang
didasarkan pada Teorema Bayes. Salah satu algoritma klasifikasi yang
paling sederhana dan efektif, klasifikasi Naïve Bayes membantu dalam
pengembangan model pembelajaran mesin yang cepat dengan kemampuan
prediksi yang cepat. Keuntungan menggunakan Naïve Bayes adalah
kecepatannya. Cepat dan mudah membuat prediksi dengan dimensi data yang
tinggi [14].
LightGBM Classifier and Regressor
LightGBM adalah kerangka kerja penguat gradien yang menggunakan
algoritma pembelajaran berbasis pohon. Kerangka kerja ini dirancang agar
terdistribusi dan efisien dengan keuntungan berikut:
Pada project ini akan digunakan sebuah data interaksi konsumen pada
sebuah kampanye digital marketing yang diambil dari situs Kaggle
dengan judul “Predict Conversion in Digital Marketing Dataset”. Dataset
ini mengandung informasi sebagai berikut:
Demographic Information
- CustomerID: Unique identifier for each customer.
- Age : Age of the customer.
- Gender: Gender of the customer (Male/Female).
- Income: Annual income of the customer in USD.
Marketing-specific Variables
- CampaignChannel: The channel through which the marketing
campaign is delivered (Email, Social Media, SEO, PPC, Referral).
- CampaignType: Type of the marketing campaign (Awareness,
Consideration, Conversion, Retention).
- AdSpend: Amount spent on the marketing campaign in
USD.
- ClickThroughRate: Rate at which customers click on the
marketing content.
- ConversionRate: Rate at which clicks convert to desired
actions (e.g., purchases).
Customer Engagement Variables
- WebsiteVisits: Number of visits to the website.
- PagesPerVisit: Average number of pages visited per
session.
- TimeOnSite: Average time spent on the website per visit
(in minutes).
- SocialShares: Number of times the marketing content was
shared on social media.
- EmailOpens: Number of times marketing emails were
opened.
- EmailClicks: Number of times links in marketing emails
were clicked.
Historical Data
- PreviousPurchases: Number of previous purchases made by
the customer.
- LoyaltyPoints: Number of loyalty points accumulated by
the customer.
Target Variable
- Conversion: Binary variable indicating whether the
customer converted (1) or not (0).
- ClickThroughRate: Rate at which customers click on the
marketing content.
Dalam proyek ini akan ada dua target variabel yang akan dibuat dengan
model yang berbeda. Target variabel pertama yaitu
Conversion akan dibuat model klasifikasi dengan
memanfaatkan algoritma Naive Bayes dan Random Forest. Sedangkan target
variabel kedua yaitu ClickThroughRate dengan menggunakan
regression model.
Asumsi:
- Pada kolom Income menggunakan satuan mata uang USD maka diasumsikan
iklan ditayangkan di Amerika Serikat.
- Pada data ini juga tidak ada keterangan produk, maka diasumsikan data
ini merupakan data iklan untuk 1 produk yang sama.
Penggunaan dashboard ini cukup mudah, pengguna diminta untuk memasukkan data pelanggan dan detail campaign. Data pelanggan meliputi umur, gender, dan pendapatan tahunan dapat dimasukkan pada bagian “Insert Customer Persona”. Detail campaign meliputi budget iklan, tipe campaign dan channel campaign dapat dimasukkan pada bagian “Insert Campaign Detail”.
Hasil prediksi akan berada pada bagian kanan dashboard yaitu customer purchasing decision prediction dan CTR prediction. Pada customer purchasing decision prediction, jika hasil prediksi memiliki angka 0-0.50 maka customer diprediksi tidak akan membeli produk yang diiklankan. Namun jika hasil prediksi menunjukkan nilai 0.51-1 maka customer diprediksi akan membeli produk yang diiklankan.
Sedangkan interpretasi nilai prediksi CTR akan menunjukkan berapa banyak klik dibandingkan jumlah tayangan iklan. Misalnya nilai prediksi CTR adalah 0.15, maka akan terdapat 15% klik dari jumlah total tayangan iklan. Pada dasarnya tidak ada standar nilai CTR yang baik karena setiap produk dan campaign channel memiliki standar nilai yang berbeda-beda [17].
Proyek ini dapat dikembangkan dengan menggunakan data dari berbagai sektor atau dapat juga dibuat spesifik untuk setiap brand atau produk. Hal ini diperlukan karena data iklan akan spesifik pada jenis produk dan segmentasi pasar. Selain itu juga dapat dikembangkan dengan menambahkan prediksi time series untuk mengetahui kapan waktu tayang terbaik.
Secara spesifik, proyek ini akan bermanfaat untuk:
- Marketer dan stakeholder, memudahkan dalam pengambilan keputusan
terutama jika data yang dimiliki sudah semakin besar.
- Pelaku umkm, memudahkan dalam pengambilan keputusan terutama karena
sebagian besar pelaku UMKM tidak memiliki pakar pemasaran.
Pada dashboard tersebut, pengguna dapat memasukkan data pelanggan dan detail campaign, kemudian dashboard akan memberikan hasil prediksi nilai customer purchasing decision dan CTR. Pada penggunaan dashboard ini, pengguna dapat memasukan ads budget yang berbeda-beda kemudian dapat dilihat perubahan hasil prediksi customer purchasing decision dan CTR. Sehingga pengguna dapat mengetahui berapa budget iklan yang dibutuhkan untuk hasil prediksi customer purchasing decison adalah “akan membeli” dan nilai CTR yang diinginkan. Dengan mengetahui berapa budget iklan yang dibutuhkan, maka pengguna tidak perlu melakukan trial and error pada penetapan budget iklan, karena seringkali budget iklan yang ditetapkan kurang atau bahkan berlebih. Jika pengguna mendapatkan hasil prediksi klasifikasi “tidak membeli” dan nilai CTR terlalu rendah, maka pengguna dapat mencoba mengganti nilai ads budget.
Duplicates & Missing Values
## [1] 0
## CustomerID Age Gender Income
## 0 0 0 0
## CampaignChannel CampaignType AdSpend ClickThroughRate
## 0 0 0 0
## ConversionRate WebsiteVisits PagesPerVisit TimeOnSite
## 0 0 0 0
## SocialShares EmailOpens EmailClicks PreviousPurchases
## 0 0 0 0
## LoyaltyPoints AdvertisingPlatform AdvertisingTool Conversion
## 0 0 0 0
Data tidak memiliki input duplikat dan missing value.
Kolom CustomerID, AdvertisingPlatform, dan AdvertisingTool akan dihilangkan karena pada proses pembangunan model tidak membutuhkan data tersebut. Beberapa kolom perlu dirubah ke dalam tipe data yang sesuai.
Kolom yang perlu dirubah menjadi bentuk factor: Gender, CampaignChannel, CampaignType, dan Conversion
dm_clean <- dm %>% select(-c(CustomerID, AdvertisingPlatform, AdvertisingTool)) %>% mutate_at(.vars=c("Gender", "CampaignChannel", "CampaignType", "Conversion"), .funs=as.factor)
glimpse(dm_clean)## Rows: 8,000
## Columns: 17
## $ Age <int> 56, 69, 46, 32, 60, 25, 38, 56, 36, 40, 28, 28, 41, …
## $ Gender <fct> Female, Male, Female, Female, Female, Female, Female…
## $ Income <int> 136912, 41760, 88456, 44085, 83964, 42925, 25615, 57…
## $ CampaignChannel <fct> Social Media, Email, PPC, PPC, PPC, Social Media, Re…
## $ CampaignType <fct> Awareness, Retention, Awareness, Conversion, Convers…
## $ AdSpend <dbl> 6497.8701, 3898.6686, 1546.4296, 539.5259, 1678.0436…
## $ ClickThroughRate <dbl> 0.04391851, 0.15572507, 0.27749037, 0.13761125, 0.25…
## $ ConversionRate <dbl> 0.08803141, 0.18272468, 0.07642272, 0.08800419, 0.10…
## $ WebsiteVisits <int> 0, 42, 2, 47, 0, 6, 42, 48, 13, 22, 47, 16, 13, 8, 2…
## $ PagesPerVisit <dbl> 2.399017, 2.917138, 8.223619, 4.540939, 2.046847, 2.…
## $ TimeOnSite <dbl> 7.396803, 5.352549, 13.794901, 14.688363, 13.993370,…
## $ SocialShares <int> 19, 5, 0, 89, 6, 95, 54, 96, 73, 14, 94, 23, 28, 81,…
## $ EmailOpens <int> 6, 2, 11, 2, 6, 5, 14, 9, 4, 8, 16, 18, 16, 8, 16, 0…
## $ EmailClicks <int> 9, 7, 2, 2, 6, 8, 3, 3, 8, 4, 5, 6, 5, 1, 8, 1, 8, 5…
## $ PreviousPurchases <int> 4, 2, 8, 0, 8, 0, 6, 0, 5, 8, 6, 5, 4, 2, 1, 1, 8, 2…
## $ LoyaltyPoints <int> 688, 3459, 2337, 2463, 4345, 3316, 930, 2983, 460, 3…
## $ Conversion <fct> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1…
## Age Gender Income CampaignChannel
## Min. :18.00 Female:4839 Min. : 20014 Email :1557
## 1st Qu.:31.00 Male :3161 1st Qu.: 51745 PPC :1655
## Median :43.00 Median : 84927 Referral :1719
## Mean :43.63 Mean : 84664 SEO :1550
## 3rd Qu.:56.00 3rd Qu.:116816 Social Media:1519
## Max. :69.00 Max. :149986
## CampaignType AdSpend ClickThroughRate ConversionRate
## Awareness :1988 Min. : 100.1 Min. :0.01000 Min. :0.01002
## Consideration:1988 1st Qu.:2523.2 1st Qu.:0.08263 1st Qu.:0.05641
## Conversion :2077 Median :5013.4 Median :0.15451 Median :0.10405
## Retention :1947 Mean :5000.9 Mean :0.15483 Mean :0.10439
## 3rd Qu.:7408.0 3rd Qu.:0.22821 3rd Qu.:0.15208
## Max. :9997.9 Max. :0.29997 Max. :0.19999
## WebsiteVisits PagesPerVisit TimeOnSite SocialShares
## Min. : 0.00 Min. :1.000 Min. : 0.5017 Min. : 0.0
## 1st Qu.:13.00 1st Qu.:3.302 1st Qu.: 4.0683 1st Qu.:25.0
## Median :25.00 Median :5.534 Median : 7.6830 Median :50.0
## Mean :24.75 Mean :5.549 Mean : 7.7277 Mean :49.8
## 3rd Qu.:37.00 3rd Qu.:7.836 3rd Qu.:11.4815 3rd Qu.:75.0
## Max. :49.00 Max. :9.999 Max. :14.9953 Max. :99.0
## EmailOpens EmailClicks PreviousPurchases LoyaltyPoints Conversion
## Min. : 0.000 Min. :0.000 Min. :0.000 Min. : 0 0: 988
## 1st Qu.: 5.000 1st Qu.:2.000 1st Qu.:2.000 1st Qu.:1255 1:7012
## Median : 9.000 Median :4.000 Median :4.000 Median :2497
## Mean : 9.477 Mean :4.467 Mean :4.486 Mean :2490
## 3rd Qu.:14.000 3rd Qu.:7.000 3rd Qu.:7.000 3rd Qu.:3702
## Max. :19.000 Max. :9.000 Max. :9.000 Max. :4999
Perbandingan antara data yang bernilai 0 dan 1 kurang seimbang, sehingga perlu dilakukan proses upsampling atau downsampling pada data training.
Dari grafik di atas, dapat dilihat bahwa sebaran usia konsumen yaitu dari rentang usia 18 tahun hingga 69 tahun. Sebagian besar konsumen merupakan usia produktif.
Berdasarkan data dari Liputan6.com [18],
pada tahun 2024 setiap generasi akan berusia:
Gen Z : 12-27 tahun
Gen Y atau milenial : 28-41 tahun
Gen X : 42-59 tahun
Baby Boomer : 60-78 tahun
convert_age <- function(x) {
if (x <= 27) # usia <= 27
{x <- "Gen Z"}
else if (x > 27 & x <= 41) #usia 28-41
{x <- "Gen Y"}
else if (x > 41 & x <= 59) #usia 42-59
{x <- "Gen X"}
else #income 100.001-150.000
{x <- "Baby Boomer"}
}dm_clean$Age_cat <- sapply(X = dm_clean$Age, # kolom yang mau diubah
FUN = convert_age)
dm_clean$Age_cat <- as.factor(dm_clean$Age_cat)Berdasarkan grafik di atas, berdasarkan urutan, yang paling banyak merupakan dari generasi X, Y, Z dan baby boomers.
Distribusi usia terhadap konversi
ggplot(data = dm_clean, mapping = aes(x=Age, group=Conversion, fill=Conversion))+
geom_density(adjust=1.5, alpha=.4)+
scale_fill_brewer(palette = "Pastel1")+
theme_ipsum()Berdasarkan grafik di atas, pada rentang usia 30 tahun dan 50-55 tahun lebih banyak pelanggan yang belum memutuskan untuk membeli. Sedangkan pada usia 40 tahun terdapat perbedaan yang cukup signifikan antara pelanggan yang memutuskan membeli dan yang belum memutuskan membeli.
Distribusi usia berdasarkan generasi terhadap konversi dan CTR
Gen_1 <- dm_clean %>%
mutate(Conversion = as.integer(Conversion)) %>%
group_by(Age_cat) %>%
summarise(ClickThroughRate = sum(ClickThroughRate),
Conversion = sum(Conversion))
Gen_1ggplot(meltGen_1,aes(x = Age_cat, y =value, fill = variable)) +
geom_bar(stat = "identity", position = "dodge")+
labs(title = "Conversion and CTR based on Generation",
x = "Age Category (Generation)",
y = "Sum",
fill="Variables") +
theme_minimal()
Hasil pada grafik di atas sejalan dengan jumlah konsumen pada setiap
generasi. Gen X memberikan nilai Conversion, ConversionRate dan
ClickThroughRate tertinggi.
Dari grafik di atas, dapat dilihat bahwa konsumen lebih banyak perempuan daripada laki-laki.
Distribusi gender terhadap konversi dan CTR
Gen_2 <- dm_clean %>%
mutate(Conversion = as.integer(Conversion)) %>%
group_by(Gender) %>%
summarise(ClickThroughRate = sum(ClickThroughRate),
ConversionRate = sum(ConversionRate),
Conversion = sum(Conversion))
Gen_2ggplot(meltGen_2,aes(x = Gender, y =value, fill = variable)) +
geom_bar(stat = "identity", position = "dodge")+
labs(title = "Conversion and CTR based on Gender",
x = "Gender",
y = "Sum",
fill="Variables") +
theme_minimal()
Berdasarkan grafik di atas, konsumen perempuan memberikan nilai
Conversion, ConversionRate, dan ClickThroughRate yang lebih besar
dibandingkan konsumen pria.
Berdasarkan grafik di atas, sebaran income konsumen cukup merata dari 20000 hingga 160000. Kemudian akan dibuat grafik sebaran income dengan dibuat kategorik.
convert_income <- function(x) {
if (x <= 50000) # income <= 50.000
{x <- "10.000-50.000"}
else if (x > 50000 & x <= 100000) #income 50.001-100.000
{x <- "50.001-100.000"}
else #income 100.001-150.000
{x <- "100.001-150.000"}
}dm_clean$Income_cat <- sapply(X = dm_clean$Income, # kolom yang mau diubah
FUN = convert_income)
dm_clean$Income_cat <- as.factor(dm_clean$Income_cat)
head(dm_clean)Berdasarkan grafik di atas, sebagian besar konsumen memiliki income 50001-150.000.
Distribusi income terhadap konversi dan CTR
Gen_3 <- dm_clean %>%
mutate(Conversion = as.integer(Conversion)) %>%
group_by(Income_cat) %>%
summarise(ClickThroughRate = sum(ClickThroughRate),
ConversionRate = sum(ConversionRate),
Conversion = sum(Conversion))
Gen_3ggplot(meltGen_3,aes(x = Income_cat, y =value, fill = variable)) +
geom_bar(stat = "identity", position = "dodge")+
labs(title = "Conversion and CTR based on Income",
x = "Income_cat",
y = "Sum",
fill="Variables") +
theme_minimal()
Konsumen yang memiliki income 100.001-150.000 memberikan nilai nilai
Conversion, ConversionRate, dan ClickThroughRate yang paling banyak,
kemudian diikuti oleh konsumen dengan income 50.001-100.000 dan
10.000-50.000.
Campaign channel yang paling banyak digunakan adalah referral, namun jumlah nya tidak signifikan jika dibandingkan dengan campaign channel lainnya.
Tipe campaign yang paling banyak digunakan adalah conversion, namun jumlahnya seimbang dengan tipe campaign lainnya.
library(reshape2)
Sum_CE <- dm_clean %>%
group_by(Age_cat) %>%
summarise(WebsiteVisits = sum(WebsiteVisits),
PagesPerVisit = sum(PagesPerVisit),
TimeOnSite = sum(TimeOnSite),
SocialShares = sum(SocialShares),
EmailOpens = sum(EmailOpens),
EmailClicks = sum(EmailClicks)) %>%
melt(id=c("Age_cat"))
Sum_CEggplot(Sum_CE,aes(x = Age_cat, y =value, fill = variable)) +
geom_bar(stat = "identity", position = "dodge")+
labs(title = "Customer Engagement Variables Based on Generation",
x = "Age Category (Generation)",
y = "Sum",
fill="Customer Engagement Variables") +
theme_minimal()Berdasarkan grafik di atas, SocialShares dan WebsiteVisits merupakan variabel customer engagement yang memberikan kontribusi terbanyak dibandingkan variabel customer engagement lainnya. Gen X, yang berusia 42-59 tahun pada tahun 2024 ini, merupakan customer yang memiliki tingkat engagement tertinggi pada seluruh variabel customer engagement. Maka campaign selanjutnya dapat difokuskan pada media sosial dan website.
Sum_CE2 <- dm_clean %>%
group_by(Gender) %>%
summarise(WebsiteVisits = sum(WebsiteVisits),
PagesPerVisit = sum(PagesPerVisit),
TimeOnSite = sum(TimeOnSite),
SocialShares = sum(SocialShares),
EmailOpens = sum(EmailOpens),
EmailClicks = sum(EmailClicks)) %>%
melt(id=c("Gender"))
Sum_CE2ggplot(Sum_CE2,aes(x = Gender, y =value, fill = variable)) +
geom_bar(stat = "identity", position = "dodge")+
labs(title = "Customer Engagement Variables Based on Gender",
x = "Gender",
y = "Sum",
fill="Customer Engagement Variables") +
theme_minimal()Berdasarkan grafik di atas, SocialShares dan WebsiteVisits merupakan variabel customer engagement yang memberikan kontribusi terbanyak dibandingkan variabel customer engagement lainnya. Konsumen perempuan merupakan customer yang memiliki tingkat engagement tertinggi pada seluruh variabel customer engagement. Maka campaign selanjutnya dapat difokuskan pada media sosial dan website serta konsumen perempuan.
Sum_CE3 <- dm_clean %>%
group_by(Income_cat) %>%
summarise(WebsiteVisits = sum(WebsiteVisits),
PagesPerVisit = sum(PagesPerVisit),
TimeOnSite = sum(TimeOnSite),
SocialShares = sum(SocialShares),
EmailOpens = sum(EmailOpens),
EmailClicks = sum(EmailClicks)) %>%
melt(id=c("Income_cat"))
Sum_CE3ggplot(Sum_CE3,aes(x = Income_cat, y =value, fill = variable)) +
geom_bar(stat = "identity", position = "dodge")+
labs(title = "Customer Engagement Variables Based on Income",
x = "Income_cat",
y = "Sum",
fill="Customer Engagement Variables") +
theme_minimal()
Berdasarkan grafik di atas, SocialShares dan WebsiteVisits merupakan
variabel customer engagement yang memberikan kontribusi terbanyak
dibandingkan variabel customer engagement lainnya. Konsumen dengan
income 100.001-150.000 merupakan customer yang memiliki tingkat
engagement tertinggi pada seluruh variabel customer engagement. Maka
campaign selanjutnya dapat difokuskan pada media sosial dan website
serta konsumen dengan income 100.001-150.000.
library(rsample)
RNGkind(sample.kind = "Rounding")
set.seed(100)
dm_cross <- sample(nrow(dm_clean), nrow(dm_clean)*0.80)
dm_trainc <- dm_clean[dm_cross,-7] # untuk training kolom ClickThroughRate tidak disertakan
dm_testc <- dm_clean[-dm_cross, -7] # untuk testing kolom ClickThroughRate tidak disertakan##
## 0 1
## 0.1248438 0.8751562
Pada data ini, kita memiliki data yang tidak balance maka perlu dilakukan upsampling atau downsampling.
library(caret)
# upsampling
RNGkind(sample.kind = "Rounding")
set.seed(100)
dm_train_up <- upSample(
x = dm_trainc %>% select(-Conversion),
y = dm_trainc$Conversion,
yname = "Conversion")
head(dm_train_up)Cek proporsi kelas target setelah melakukan upsampling.
##
## 0 1
## 0.5 0.5
Pada data ini terdapat kolom numerik yang range nilainya sangat jauh berbeda dari kolom numerik lainnya seperti AdSpend, Income dan LoyaltyPoints. Maka akan dilakukan scaling pada data ini. Scaling ini bertujuan untuk standarisasi nilai pada kolom numerik sehingga setiap kolom numerik memiliki range yang sama. Scaling adalah proses mengubah nilai fitur dari kumpulan data hingga berada dalam rentang tertentu, misalnya 0 hingga 1 atau -1 hingga 1. Hal ini dilakukan untuk memastikan bahwa tidak ada satu fitur pun yang mendominasi perhitungan jarak dalam suatu algoritma, dan dapat membantu meningkatkan kinerja algoritma tersebut. Ada beberapa metode penskalaan data, termasuk:
Proses scaling akan dilakukan dengan metode z-score karena tidak diketahui standar nilai minimal dan maksimal dari kolom numerik. Sebelum dilakukan scaling, akan dipisahkan data train dan test dari kolom targetnya kemudian dilakukan scaling agar kolom target nilainya tidak berubah. Scaling juga hanya dapat dilakukan pada kolom numerik, sehingga kolom factor perlu diubah terlebih dahulu menjadi numerik. Scaling ini juga hanya dilakukan pada kolom-kolom prediktor saja.
#Memisahkan kolom numerik dan kolom faktor
#data train
ctrain_upnum <- dm_train_up %>% select(is.numeric)
ctrain_upcat <- dm_train_up %>% select(is.factor)
#data test
ctest_num <- dm_testc %>% select(is.numeric)
ctest_cat <- dm_testc %>% select(is.factor)# Scaling dilakukan pada data frame prediktor numerik
# train
ctrain_xs <- scale(ctrain_upnum)
# test
ctest_xs <- scale(ctest_num,
center = attr(ctrain_xs, "scaled:center"), # nilai rata-rata/mean nilai center data ctrain_xs
scale = attr(ctrain_xs, "scaled:scale")) # nilai stdev nilai center data ctrain_xsKemudian pada data train digabungkan kolom prediktor hasil scaling dan kolom target yang tidak di scaling.
library(rsample)
RNGkind(sample.kind = "Rounding")
set.seed(100)
r_cross <- sample(nrow(dm_clean), nrow(dm_clean)*0.80)
r_train <- dm_clean[r_cross,-17] # untuk training kolom Conversion tidak disertakan
r_test <- dm_clean[-r_cross, -17] # untuk testing kolom Conversion tidak disertakan#Memisahkan kolom numerik dan kolom faktor, kolom target tidak ikut proses scaling
#data train
rtrain_upnum <- r_train %>% select(-7) %>% select(is.numeric)
rtrain_upcat <- r_train %>% select(is.factor)
#data test
rtest_num <- r_test %>% select(-7) %>% select(is.numeric)
rtest_cat <- r_test %>% select(is.factor)# Scaling dilakukan pada data frame prediktor numerik
# train
rtrain_xs <- scale(rtrain_upnum)
# test
rtest_xs <- scale(rtest_num,
center = attr(rtrain_xs, "scaled:center"), # nilai rata-rata/mean nilai center data ctrain_xs
scale = attr(rtrain_xs, "scaled:scale")) # nilai stdev nilai center data ctrain_xsKemudian pada data train digabungkan kolom prediktor hasil scaling dan kolom target yang tidak di scaling.
#Data hasil scaling
#data train
rtrain_s <- cbind(data.frame(rtrain_xs), rtrain_upcat, data.frame(r_train$ClickThroughRate))
rtrain_s <- rename(rtrain_s, ClickThroughRate = r_train.ClickThroughRate )
#data test
rtest_s <- cbind(data.frame(rtest_xs), rtest_cat, r_test[,7])
rtest_s <- rename(rtest_s, ClickThroughRate = "r_test[, 7]" )Model
c_model_log <- glm(formula = Conversion ~ .,
family = "binomial",
data = ctrain_s) #data numerik sudah di scaling
summary(c_model_log)##
## Call:
## glm(formula = Conversion ~ ., family = "binomial", data = ctrain_s)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 0.0016253 0.1634958 0.010 0.9921
## Age -0.1980790 0.0808947 -2.449 0.0143 *
## Income 0.0723778 0.0631433 1.146 0.2517
## AdSpend 0.3760718 0.0220542 17.052 <2e-16 ***
## ConversionRate 0.2295817 0.0218671 10.499 <2e-16 ***
## WebsiteVisits 0.2465381 0.0218116 11.303 <2e-16 ***
## PagesPerVisit 0.3251843 0.0219939 14.785 <2e-16 ***
## TimeOnSite 0.4520006 0.0222530 20.312 <2e-16 ***
## SocialShares -0.0353564 0.0217706 -1.624 0.1044
## EmailOpens 0.3623685 0.0220367 16.444 <2e-16 ***
## EmailClicks 0.3955329 0.0220265 17.957 <2e-16 ***
## PreviousPurchases 0.3603988 0.0220840 16.319 <2e-16 ***
## LoyaltyPoints 0.3180293 0.0220185 14.444 <2e-16 ***
## GenderMale -0.0199857 0.0446154 -0.448 0.6542
## CampaignChannelPPC 0.2070562 0.0690254 3.000 0.0027 **
## CampaignChannelReferral 0.1171472 0.0682896 1.715 0.0863 .
## CampaignChannelSEO 0.1105089 0.0704130 1.569 0.1165
## CampaignChannelSocial Media -0.0670988 0.0697176 -0.962 0.3358
## CampaignTypeConsideration 0.0001962 0.0590588 0.003 0.9973
## CampaignTypeConversion 0.9265475 0.0652858 14.192 <2e-16 ***
## CampaignTypeRetention 0.0671836 0.0592056 1.135 0.2565
## Age_catGen X -0.2061507 0.0972567 -2.120 0.0340 *
## Age_catGen Y -0.3995655 0.1746869 -2.287 0.0222 *
## Age_catGen Z -0.5904465 0.2382046 -2.479 0.0132 *
## Income_cat100.001-150.000 -0.0230356 0.1593407 -0.145 0.8851
## Income_cat50.001-100.000 0.1068958 0.0865780 1.235 0.2170
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 15529 on 11201 degrees of freedom
## Residual deviance: 12547 on 11176 degrees of freedom
## AIC: 12599
##
## Number of Fisher Scoring iterations: 4
Prediction
# Prediction data test
cpred_log_test <- predict(c_model_log, ctest_s, type = "response")
cpred_log_test <- ifelse(cpred_log_test > 0.5, yes = 1, no = 0)
head(cpred_log_test)## 5 15 16 17 23 31
## 1 1 0 1 1 0
# Prediction data train
cpred_log_train <- predict(c_model_log, ctrain_s, type = "response")
cpred_log_train <- ifelse(cpred_log_train > 0.5, yes = 1, no = 0)
head(cpred_log_train)## 1 2 3 4 5 6
## 0 0 0 1 0 0
Evaluation
#data test
cm_test_c1 <- confusionMatrix(data = as.factor(cpred_log_test),
reference = ctest_s$Conversion,
positive = "1")
cm_test_c1## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 126 374
## 1 63 1037
##
## Accuracy : 0.7269
## 95% CI : (0.7043, 0.7486)
## No Information Rate : 0.8819
## P-Value [Acc > NIR] : 1
##
## Kappa : 0.2345
##
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 0.7349
## Specificity : 0.6667
## Pos Pred Value : 0.9427
## Neg Pred Value : 0.2520
## Prevalence : 0.8819
## Detection Rate : 0.6481
## Detection Prevalence : 0.6875
## Balanced Accuracy : 0.7008
##
## 'Positive' Class : 1
##
#data train
cm_train_c1 <- confusionMatrix(data = as.factor(cpred_log_train),
reference = ctrain_s$Conversion,
positive = "1")
cm_train_c1## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 4064 1589
## 1 1537 4012
##
## Accuracy : 0.7209
## 95% CI : (0.7125, 0.7292)
## No Information Rate : 0.5
## P-Value [Acc > NIR] : <2e-16
##
## Kappa : 0.4419
##
## Mcnemar's Test P-Value : 0.3617
##
## Sensitivity : 0.7163
## Specificity : 0.7256
## Pos Pred Value : 0.7230
## Neg Pred Value : 0.7189
## Prevalence : 0.5000
## Detection Rate : 0.3582
## Detection Prevalence : 0.4954
## Balanced Accuracy : 0.7209
##
## 'Positive' Class : 1
##
eval_c_log <- data_frame(Model = "Log Reg",
Accuracy_Train = cm_train_c1$overall[1],
Accuracy_Test = cm_test_c1$overall[1],
Selisih_Accuracy = (Accuracy_Test-Accuracy_Train),
Recall_Train = cm_train_c1$byClass[1],
Recall_Test = cm_test_c1$byClass[1],
Selisih_Recall = (Recall_Test-Recall_Train),
Precision_Train = cm_train_c1$byClass[3],
Precision_Test = cm_test_c1$byClass[3],
Selisih_Precision = (Precision_Test-Precision_Train),)
eval_c_logModel
#model_forestclass <- train(Conversion ~ .,
# data = ctrain_s,
# method = "rf")
#saveRDS(model_forestclass, "model_forestclass.RDS")## Random Forest
##
## 11202 samples
## 17 predictor
## 2 classes: '0', '1'
##
## No pre-processing
## Resampling: Bootstrapped (25 reps)
## Summary of sample sizes: 11202, 11202, 11202, 11202, 11202, 11202, ...
## Resampling results across tuning parameters:
##
## mtry Accuracy Kappa
## 2 0.9929423 0.9858834
## 13 0.9795758 0.9591484
## 25 0.9732004 0.9463977
##
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was mtry = 2.
Prediction
# Prediction data test
cpred_forest_test <- predict(c_model_forest, ctest_s)
head(cpred_forest_test)## [1] 1 1 1 1 1 1
## Levels: 0 1
# Prediction data train
cpred_forest_train <- predict(c_model_forest, ctrain_s)
head(cpred_forest_train)## [1] 0 0 0 0 0 0
## Levels: 0 1
Evaluation
#Confusion matrix data test
cm_test_c2 <- confusionMatrix(data = cpred_forest_test, reference = ctest_s$Conversion, positive = "1")
cm_test_c2## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 18 4
## 1 171 1407
##
## Accuracy : 0.8906
## 95% CI : (0.8743, 0.9055)
## No Information Rate : 0.8819
## P-Value [Acc > NIR] : 0.1476
##
## Kappa : 0.1497
##
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 0.99717
## Specificity : 0.09524
## Pos Pred Value : 0.89163
## Neg Pred Value : 0.81818
## Prevalence : 0.88187
## Detection Rate : 0.87938
## Detection Prevalence : 0.98625
## Balanced Accuracy : 0.54620
##
## 'Positive' Class : 1
##
#Confusion matrix data train
cm_train_c2 <- confusionMatrix(data = cpred_forest_train, reference = ctrain_s$Conversion, positive = "1")
cm_train_c2## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 5601 0
## 1 0 5601
##
## Accuracy : 1
## 95% CI : (0.9997, 1)
## No Information Rate : 0.5
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 1
##
## Mcnemar's Test P-Value : NA
##
## Sensitivity : 1.0
## Specificity : 1.0
## Pos Pred Value : 1.0
## Neg Pred Value : 1.0
## Prevalence : 0.5
## Detection Rate : 0.5
## Detection Prevalence : 0.5
## Balanced Accuracy : 1.0
##
## 'Positive' Class : 1
##
eval_c_forest <- data_frame(Model = "RF",
Accuracy_Train = cm_train_c2$overall[1],
Accuracy_Test = cm_test_c2$overall[1],
Selisih_Accuracy = (Accuracy_Test-Accuracy_Train),
Recall_Train = cm_train_c2$byClass[1],
Recall_Test = cm_test_c2$byClass[1],
Selisih_Recall = (Recall_Test-Recall_Train),
Precision_Train = cm_train_c2$byClass[3],
Precision_Test = cm_test_c2$byClass[3],
Selisih_Precision = (Precision_Test-Precision_Train))
eval_c_forestModel
library(e1071)
model_bayes <- naiveBayes(formula = Conversion ~ .,
data = ctrain_s,
laplace = 1)
model_bayes##
## Naive Bayes Classifier for Discrete Predictors
##
## Call:
## naiveBayes.default(x = X, y = Y, laplace = laplace)
##
## A-priori probabilities:
## Y
## 0 1
## 0.5 0.5
##
## Conditional probabilities:
## Age
## Y [,1] [,2]
## 0 0.001018415 1.0100734
## 1 -0.001018415 0.9899132
##
## Income
## Y [,1] [,2]
## 0 -0.0245894 1.0100995
## 1 0.0245894 0.9892766
##
## AdSpend
## Y [,1] [,2]
## 0 -0.1950613 0.9446223
## 1 0.1950613 1.0157539
##
## ConversionRate
## Y [,1] [,2]
## 0 -0.1308308 1.029584
## 1 0.1308308 0.951786
##
## WebsiteVisits
## Y [,1] [,2]
## 0 -0.119996 1.0379170
## 1 0.119996 0.9455706
##
## PagesPerVisit
## Y [,1] [,2]
## 0 -0.1576879 1.0248730
## 1 0.1576879 0.9487224
##
## TimeOnSite
## Y [,1] [,2]
## 0 -0.2166299 0.9729950
## 1 0.2166299 0.9795843
##
## SocialShares
## Y [,1] [,2]
## 0 0.008429244 1.0046123
## 1 -0.008429244 0.9953846
##
## EmailOpens
## Y [,1] [,2]
## 0 -0.1834572 0.9861664
## 1 0.1834572 0.9799639
##
## EmailClicks
## Y [,1] [,2]
## 0 -0.188304 0.9803411
## 1 0.188304 0.9839616
##
## PreviousPurchases
## Y [,1] [,2]
## 0 -0.1684107 1.0241455
## 1 0.1684107 0.9458172
##
## LoyaltyPoints
## Y [,1] [,2]
## 0 -0.1469424 1.0089519
## 1 0.1469424 0.9690215
##
## Gender
## Y Female Male
## 0 0.6019989 0.3980011
## 1 0.6018205 0.3981795
##
## CampaignChannel
## Y Email PPC Referral SEO Social Media
## 0 0.2013914 0.1887264 0.2044238 0.1949697 0.2104888
## 1 0.1905102 0.2104888 0.2186943 0.1924724 0.1878345
##
## CampaignType
## Y Awareness Consideration Conversion Retention
## 0 0.2949153 0.2931311 0.1330955 0.2788582
## 1 0.2415700 0.2444246 0.2793934 0.2346120
##
## Age_cat
## Y Baby Boomer Gen X Gen Y Gen Z
## 0 0.1935772 0.3462979 0.2765388 0.1835861
## 1 0.1957181 0.3445138 0.2795718 0.1801963
##
## Income_cat
## Y 10.000-50.000 100.001-150.000 50.001-100.000
## 0 0.2585653 0.3799072 0.3615275
## 1 0.2371520 0.3911492 0.3716988
Prediction
#data test prediction
test_naive_pred <- predict(model_bayes,
ctest_s,
type = "class")
head(test_naive_pred)## [1] 1 1 0 0 1 1
## Levels: 0 1
#data train prediction
train_naive_pred <- predict(model_bayes,
ctrain_s,
type = "class")
head(train_naive_pred)## [1] 0 0 0 1 0 0
## Levels: 0 1
Evaluation
# data test confusion matrix
cm_test_c3 <-confusionMatrix(data = test_naive_pred,
reference = ctest_s$Conversion,
positive = "1",
mode = "everything")
cm_test_c3## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 133 370
## 1 56 1041
##
## Accuracy : 0.7338
## 95% CI : (0.7114, 0.7553)
## No Information Rate : 0.8819
## P-Value [Acc > NIR] : 1
##
## Kappa : 0.2568
##
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 0.7378
## Specificity : 0.7037
## Pos Pred Value : 0.9490
## Neg Pred Value : 0.2644
## Precision : 0.9490
## Recall : 0.7378
## F1 : 0.8301
## Prevalence : 0.8819
## Detection Rate : 0.6506
## Detection Prevalence : 0.6856
## Balanced Accuracy : 0.7207
##
## 'Positive' Class : 1
##
# data train confusion matrix
cm_train_c3 <-confusionMatrix(data = train_naive_pred,
reference = ctrain_s$Conversion,
positive = "1",
mode = "everything")
cm_train_c3## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 4175 1552
## 1 1426 4049
##
## Accuracy : 0.7342
## 95% CI : (0.7259, 0.7423)
## No Information Rate : 0.5
## P-Value [Acc > NIR] : < 2e-16
##
## Kappa : 0.4683
##
## Mcnemar's Test P-Value : 0.02199
##
## Sensitivity : 0.7229
## Specificity : 0.7454
## Pos Pred Value : 0.7395
## Neg Pred Value : 0.7290
## Precision : 0.7395
## Recall : 0.7229
## F1 : 0.7311
## Prevalence : 0.5000
## Detection Rate : 0.3615
## Detection Prevalence : 0.4888
## Balanced Accuracy : 0.7342
##
## 'Positive' Class : 1
##
eval_c_bayes <- data_frame(Model = "NB",
Accuracy_Train = cm_train_c3$overall[1],
Accuracy_Test = cm_test_c3$overall[1],
Selisih_Accuracy = (Accuracy_Test-Accuracy_Train),
Recall_Train = cm_train_c3$byClass[1],
Recall_Test = cm_test_c3$byClass[1],
Selisih_Recall = (Recall_Test-Recall_Train),
Precision_Train = cm_train_c3$byClass[3],
Precision_Test = cm_test_c3$byClass[3],
Selisih_Precision = (Precision_Test-Precision_Train))
eval_c_bayesModel
library(tidymodels)
#using tidymodels - parsnip package
Cmodel_xgb <- boost_tree() %>%
set_mode("classification") %>%
set_engine("xgboost") %>%
fit(Conversion ~ ., data = ctrain_s)Prediction
# prediction on training data and testing data with model from tidymodels
cpred_train_xgboost <- predict(object = Cmodel_xgb, new_data = ctrain_s)
cpred_test_xgboost <- predict(object = Cmodel_xgb, new_data = ctest_s)
head(cpred_train_xgboost)Evaluation
#confusion matrix data train
cm_train_c5 <- confusionMatrix(data = cpred_train_xgboost$.pred_class,
reference = ctrain_s$Conversion,
positive = "1",
mode = "everything")
cm_train_c5## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 5103 330
## 1 498 5271
##
## Accuracy : 0.9261
## 95% CI : (0.9211, 0.9309)
## No Information Rate : 0.5
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.8522
##
## Mcnemar's Test P-Value : 6.489e-09
##
## Sensitivity : 0.9411
## Specificity : 0.9111
## Pos Pred Value : 0.9137
## Neg Pred Value : 0.9393
## Precision : 0.9137
## Recall : 0.9411
## F1 : 0.9272
## Prevalence : 0.5000
## Detection Rate : 0.4705
## Detection Prevalence : 0.5150
## Balanced Accuracy : 0.9261
##
## 'Positive' Class : 1
##
#confusion matrix data test
cm_test_c5 <- confusionMatrix(data = cpred_test_xgboost$.pred_class,
reference = ctest_s$Conversion,
positive = "1",
mode = "everything")
cm_test_c5## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 96 156
## 1 93 1255
##
## Accuracy : 0.8444
## 95% CI : (0.8257, 0.8618)
## No Information Rate : 0.8819
## P-Value [Acc > NIR] : 1
##
## Kappa : 0.3473
##
## Mcnemar's Test P-Value : 8.527e-05
##
## Sensitivity : 0.8894
## Specificity : 0.5079
## Pos Pred Value : 0.9310
## Neg Pred Value : 0.3810
## Precision : 0.9310
## Recall : 0.8894
## F1 : 0.9097
## Prevalence : 0.8819
## Detection Rate : 0.7844
## Detection Prevalence : 0.8425
## Balanced Accuracy : 0.6987
##
## 'Positive' Class : 1
##
eval_c_xgb <- data_frame(Model = "XGBoost",
Accuracy_Train = cm_train_c5$overall[1],
Accuracy_Test = cm_test_c5$overall[1],
Selisih_Accuracy = (Accuracy_Test-Accuracy_Train),
Recall_Train = cm_train_c5$byClass[1],
Recall_Test = cm_test_c5$byClass[1],
Selisih_Recall = (Recall_Test-Recall_Train),
Precision_Train = cm_train_c5$byClass[3],
Precision_Test = cm_test_c5$byClass[3],
Selisih_Precision = (Precision_Test-Precision_Train))
eval_c_xgbModel
##
## Call:
## lm(formula = ClickThroughRate ~ ., data = rtrain_s)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.158354 -0.072398 -0.000234 0.073118 0.156695
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.1574093 0.0078965 19.934 <2e-16 ***
## Age -0.0004259 0.0038096 -0.112 0.9110
## Income 0.0003855 0.0030213 0.128 0.8985
## AdSpend 0.0005887 0.0010555 0.558 0.5771
## ConversionRate -0.0006493 0.0010562 -0.615 0.5387
## WebsiteVisits -0.0018327 0.0010548 -1.737 0.0824 .
## PagesPerVisit 0.0001116 0.0010561 0.106 0.9159
## TimeOnSite -0.0007822 0.0010552 -0.741 0.4586
## SocialShares -0.0014969 0.0010549 -1.419 0.1559
## EmailOpens -0.0009950 0.0010553 -0.943 0.3458
## EmailClicks -0.0009880 0.0010550 -0.936 0.3491
## PreviousPurchases 0.0003771 0.0010560 0.357 0.7210
## LoyaltyPoints -0.0007685 0.0010552 -0.728 0.4664
## GenderMale 0.0017891 0.0021579 0.829 0.4071
## CampaignChannelPPC 0.0029824 0.0033423 0.892 0.3723
## CampaignChannelReferral -0.0029971 0.0033070 -0.906 0.3648
## CampaignChannelSEO -0.0022117 0.0034076 -0.649 0.5163
## CampaignChannelSocial Media 0.0001727 0.0034128 0.051 0.9596
## CampaignTypeConsideration -0.0035803 0.0029931 -1.196 0.2317
## CampaignTypeConversion -0.0026983 0.0029587 -0.912 0.3618
## CampaignTypeRetention -0.0005783 0.0030193 -0.192 0.8481
## Age_catGen X 0.0027735 0.0046789 0.593 0.5534
## Age_catGen Y -0.0029160 0.0082478 -0.354 0.7237
## Age_catGen Z -0.0038887 0.0112850 -0.345 0.7304
## Income_cat100.001-150.000 0.0005981 0.0076850 0.078 0.9380
## Income_cat50.001-100.000 -0.0014307 0.0042307 -0.338 0.7352
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.08428 on 6374 degrees of freedom
## Multiple R-squared: 0.003426, Adjusted R-squared: -0.0004824
## F-statistic: 0.8766 on 25 and 6374 DF, p-value: 0.6406
Prediction
#data train
pred_linear_train <- predict(object = model_linear , newdata = rtrain_s)
head(pred_linear_train)## 2463 2062 4418 451 3747 3868
## 0.1665000 0.1600465 0.1460800 0.1548152 0.1527533 0.1531709
#data test
pred_linear_test <- predict(object = model_linear , newdata = rtest_s)
head(pred_linear_test)## 5 15 16 17 23 31
## 0.1586847 0.1599881 0.1540630 0.1555499 0.1538918 0.1574799
Evaluation
library(MLmetrics)
eval_r_linear <- data_frame(Model = "Linear Reg",
MAE_train = MAE(pred_linear_train , rtrain_s$ClickThroughRate),
MAE_test = MAE(pred_linear_test , rtest_s$ClickThroughRate),
Selisih_MAE = (MAE_test-MAE_train),
RMSE_train = RMSE(pred_linear_train , rtrain_s$ClickThroughRate),
RMSE_test = RMSE(pred_linear_test , rtest_s$ClickThroughRate),
Selisih_RMSE = (RMSE_test-RMSE_train))
eval_r_linearModel
library(randomForest)
#set.seed(100)
#model_forestreg <- randomForest(ClickThroughRate ~ .,
# data=rtrain_s)
#saveRDS(model_forestreg, "model_forestreg.RDS")##
## Call:
## randomForest(formula = ClickThroughRate ~ ., data = rtrain_s)
## Type of random forest: regression
## Number of trees: 500
## No. of variables tried at each split: 5
##
## Mean of squared residuals: 0.007223262
## % Var explained: -1.77
Prediction
# prediction on training data and testing data
rpred_train_rf1 <- predict(object = rmodel_rf1, new_data = rtrain_s)
rpred_test_rf1 <- predict(object = rmodel_rf1, new_data = rtest_s)
head(rpred_train_rf1)## 2463 2062 4418 451 3747 3868
## 0.1557763 0.1434253 0.1524791 0.1563086 0.1498749 0.1552310
Evaluation
#Error evaluation
eval_r_rf1 <- data_frame(Model = "RF Reg",
MAE_train = MAE(rpred_train_rf1 , rtrain_s$ClickThroughRate),
MAE_test = MAE(rpred_test_rf1 , rtest_s$ClickThroughRate),
Selisih_MAE = (MAE_test-MAE_train),
RMSE_train = RMSE(rpred_train_rf1 , rtrain_s$ClickThroughRate),
RMSE_test = RMSE(rpred_test_rf1 , rtest_s$ClickThroughRate),
Selisih_RMSE = (RMSE_test-RMSE_train))
eval_r_rf1Model
#prepare training and validation data
library(Matrix)
library(lightgbm)
trainm1 = sparse.model.matrix(ClickThroughRate ~., data = rtrain_s)
train_label1 = rtrain_s[,"ClickThroughRate"]
testm1 = sparse.model.matrix(ClickThroughRate~., data= rtest_s)
test_label1 = rtest_s[,"ClickThroughRate"]
train_matrix1 = lgb.Dataset(data = as.matrix(trainm1), label = train_label1)
test_matrix1 = lgb.Dataset(data = as.matrix(testm1), label = test_label1)# define regression model parameters
params1 = list(
objective = "regression",
metric = "l2", min_data = 1L, learning_rate = 0.3)
# validataion data
valids = list(test = test_matrix1)# train lgbm reg model
model_lgbmr = lgb.train(
params = params1,
data = train_matrix1,
nrounds = 5L,
valids = valids)## [LightGBM] [Warning] Found whitespace in feature_names, replace with underlines
## [LightGBM] [Info] Auto-choosing col-wise multi-threading, the overhead of testing was 0.003301 seconds.
## You can set `force_col_wise=true` to remove the overhead.
## [LightGBM] [Info] Total Bins 1804
## [LightGBM] [Info] Number of data points in the train set: 6400, number of used features: 25
## [LightGBM] [Info] Start training from score 0.155100
## [1]: test's l2:0.00691345
## [2]: test's l2:0.00693448
## [3]: test's l2:0.00696441
## [4]: test's l2:0.00701244
## [5]: test's l2:0.007023
Prediction
# prediction
pred_testxgb = predict(model_lgbmr, testm1)
pred_trainxgb = predict(model_lgbmr, trainm1)
head(pred_testxgb)## 5 15 16 17 23 31
## 0.1712937 0.1566171 0.1543789 0.1489123 0.1566171 0.1566171
Evaluation
eval_r_lgbm <- data_frame(Model = "LGBM",
MAE_train = MAE(pred_trainxgb , rtrain_s$ClickThroughRate),
MAE_test = MAE(pred_testxgb , rtest_s$ClickThroughRate),
Selisih_MAE = (MAE_test-MAE_train),
RMSE_train = RMSE(pred_trainxgb , rtrain_s$ClickThroughRate),
RMSE_test = RMSE(pred_testxgb , rtest_s$ClickThroughRate),
Selisih_RMSE = (RMSE_test-RMSE_train))
eval_r_lgbmModel
#using tidymodels - parsnip package
rmodel_xgb <- boost_tree() %>%
set_mode("regression") %>%
set_engine("xgboost") %>%
fit(ClickThroughRate ~ ., data = rtrain_s)Prediction
# prediction on training data and testing data with model from tidymodels
xgbr_train_pred <- predict(object = rmodel_xgb, new_data = rtrain_s)
xgbr_test_pred <- predict(object = rmodel_xgb, new_data = rtest_s)Evaluation
eval_r_xgb <- data_frame(Model = "XGBoost Reg",
MAE_train = MAE(xgbr_train_pred$.pred, rtrain_s$ClickThroughRate),
MAE_test = MAE(xgbr_test_pred$.pred, rtest_s$ClickThroughRate),
Selisih_MAE = (MAE_test-MAE_train),
RMSE_train = RMSE(xgbr_train_pred$.pred, rtrain_s$ClickThroughRate),
RMSE_test = RMSE(xgbr_test_pred$.pred, rtest_s$ClickThroughRate),
Selisih_RMSE = (RMSE_test-RMSE_train)
)
eval_r_xgbSummary Classification Model
Pada evaluasi model, digunakan parameter accuracy, recall dan precision.
Accuracy dipilih karena kedua kelas dianggap penting. Accuracy dihitung
berdasarkan nilai prediksi benar (true positive dan true negative)
terhadap keseluruhan data. Recall dan precision lebih menitikberatkan
pada salah satu kelas, yaitu nilai true positive. Recall dihitung
berdasarkan nilai true positive terhadap jumlah true positive dan false
negative. Sedangkan precision dihitung berdasarkan nilai true positive
terhadap jumlah true positive dan false positive. Nilai accuracy, recall
dan precision mendekati satu adalah indikasi model yang baik.
Berdasarkan tabel evaluasi model klasifikasi di atas, dari keempat model pada dasarnya memberikan hasil yang baik. Namun dalam hal pemilihan model terbaik, akan dipilih model yang memiliki performa yang baik pada data train dan data test. Model yang memiliki perbedaan error yang tidak signifikan antara hasil evaluasi pada data train dan data test, dapat dikatakan bahwa model tersebut tidak overfitting ataupun underfitting. Model yang memiliki nilai accuracy, recall dan precision tertinggi adalah random forest. Namun model random forest memberikan nilai 1 pada accuracy, recall dan precision data train dan performa akan turun pada data test. Nilai penurunan performa model random forest lebih besar dibandingkan dengan model XGBoost. Maka selanjutnya akan dilakukan tuning pada model Random Forest dan XGBoost.
Summary Regression Model
MAE adalah salah satu metode evaluasi yang umum digunakan dalam data
science. MAE menghitung rata-rata dari selisih absolut antara nilai
prediksi dan nilai aktual. Dengan kata lain, MAE menghitung berapa
rata-rata kesalahan absolut dalam prediksi. Semakin kecil nilai MAE,
semakin baik kualitas model tersebut.
RMSE adalah turunan dari MSE. Seperti namanya, RMSE adalah akar kuadrat dari MSE. RMSE menghitung rata-rata dari selisih kuadrat antara nilai prediksi dan nilai aktual kemudian diambil akar kuadratnya. Semakin kecil nilai RMSE, semakin baik kualitas model tersebut. Dipilih kedua jenis error ini karena keduanya mudah diinterpretasikan.
## [1] 0.01000485 0.29996826
Interpretasi nilai MAE adalah dengan membandingkan dengan data pada kolom target. Jika dilihat nilai MAE pada data di atas, nilai 0.07 cukup kecil. Sedangkan nilai RMSE menunjukkan rata-rata error pada seluruh data. Jika dilihat nilai RMSE pada data di atas, nilai 0.08 cukup kecil. Berdasarkan tabel evaluasi model regresi di atas, dari keempat model pada dasarnya memberikan hasil yang baik. Namun dalam hal pemilihan model terbaik, akan dipilih model yang memiliki performa yang baik pada data train dan data test. Model yang memiliki perbedaan error yang tidak signifikan antara hasil evaluasi pada data train dan data test, dapat dikatakan bahwa model tersebut tidak overfitting ataupun underfitting. Model yang memiliki nilai MAE dan RMSE paling rendah pada data train adalah XGBoost. Sedangkan pada data test, model linear regression dan lightgbm memberikan nilai error yang sangat mirip. Namun model linear regression memiliki penurunan performa pada data test yang lebih besar dibandingkan model lightgbm. Oleh karena itu kemudian akan dilakukan tuning pada model lightgbm dan XGBoost.
Mencari nilai mtry dengan nilai out-of-bag (OOB) error terendah
library(randomForest)
set.seed(100)
bestmtry <- tuneRF(x = ctrain_s[,-18], y = ctrain_s[,18], stepFactor=1.5, improve=1e-5, ntree=2500)## mtry = 4 OOB error = 0.43%
## Searching left ...
## mtry = 3 OOB error = 0.3%
## 0.2916667 1e-05
## mtry = 2 OOB error = 0.12%
## 0.6176471 1e-05
## Searching right ...
## mtry = 6 OOB error = 0.82%
## -6.076923 1e-05
## mtry OOBError
## 2.OOB 2 0.001160507
## 3.OOB 3 0.003035172
## 4.OOB 4 0.004284949
## 6.OOB 6 0.008212819
Pada proses tuning ini dilakukan 6 kali percobaan dengan menggunakan
fungsi tuneRF() dengan hasil sebagai berikut
| ntree | mtry | OOB |
|——–|——–|——-|
| 100 | 2 | 0.32% |
| 400 | 2 | 0.18% |
| 500 | 2 | 0.12% |
| 1000 | 2 | 0.13% |
| 1500 | 2 | 0.15% |
| 2500 | 2 | 0.12% |
Dari data percobaan tersebut di dapatkan nilai mtry optimum adalah 2 dan nilai ntree optimum adalah 500. Maka selanjutnya nilai mtry dan ntree ini yang akan digunakan pada pembuatan model
Model
#train_ctrl <- trainControl(method = "repeatedcv",
# number = 5,
# repeats = 5)
#tunegrid <- expand.grid(mtry=2) #, ntree=500)
#model_forestclass_tune <- train(Conversion ~ .,
# data = ctrain_s,
# method = "rf",
# trControl = train_ctrl,
# tuneGrid = tunegrid, ntree = 500)
#saveRDS(model_forestclass_tune, "model_forestclass_tune.RDS")## Random Forest
##
## 11202 samples
## 17 predictor
## 2 classes: '0', '1'
##
## No pre-processing
## Resampling: Cross-Validated (5 fold, repeated 5 times)
## Summary of sample sizes: 8962, 8961, 8962, 8961, 8962, 8962, ...
## Resampling results:
##
## Accuracy Kappa
## 0.9962329 0.9924657
##
## Tuning parameter 'mtry' was held constant at a value of 2
Prediction
# Prediction data test
cpred_rftune_test <- predict(c_rf_tune, ctest_s)
# Prediction data train
cpred_rftune_train <- predict(c_rf_tune, ctrain_s)
head(cpred_rftune_train)## [1] 0 0 0 0 0 0
## Levels: 0 1
Evaluation
#Confusion matrix data test
cm_rftest_tune <- confusionMatrix(data = cpred_rftune_test, reference = ctest_s$Conversion, positive = "1")
cm_rftest_tune## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 20 3
## 1 169 1408
##
## Accuracy : 0.8925
## 95% CI : (0.8763, 0.9073)
## No Information Rate : 0.8819
## P-Value [Acc > NIR] : 0.09944
##
## Kappa : 0.1673
##
## Mcnemar's Test P-Value : < 2e-16
##
## Sensitivity : 0.9979
## Specificity : 0.1058
## Pos Pred Value : 0.8928
## Neg Pred Value : 0.8696
## Prevalence : 0.8819
## Detection Rate : 0.8800
## Detection Prevalence : 0.9856
## Balanced Accuracy : 0.5518
##
## 'Positive' Class : 1
##
#Confusion matrix data train
cm_rftrain_tune <- confusionMatrix(data = cpred_rftune_train, reference = ctrain_s$Conversion, positive = "1")
cm_rftrain_tune## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 5601 0
## 1 0 5601
##
## Accuracy : 1
## 95% CI : (0.9997, 1)
## No Information Rate : 0.5
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 1
##
## Mcnemar's Test P-Value : NA
##
## Sensitivity : 1.0
## Specificity : 1.0
## Pos Pred Value : 1.0
## Neg Pred Value : 1.0
## Prevalence : 0.5
## Detection Rate : 0.5
## Detection Prevalence : 0.5
## Balanced Accuracy : 1.0
##
## 'Positive' Class : 1
##
eval_c_foresttune <- data_frame(Model = "RFTune",
Accuracy_Train = cm_rftrain_tune$overall[1],
Accuracy_Test = cm_rftest_tune$overall[1],
Selisih_Accuracy = (Accuracy_Test-Accuracy_Train),
Recall_Train = cm_rftrain_tune$byClass[1],
Recall_Test = cm_rftest_tune$byClass[1],
Selisih_Recall = (Recall_Test-Recall_Train),
Precision_Train = cm_rftrain_tune$byClass[3],
Precision_Test = cm_rftest_tune$byClass[3],
Selisih_Precision = (Precision_Test-Precision_Train))
eval_c_foresttune#using one hot encoding
labels <- ctrain_s$Conversion #menggunakan data yang sudah di scaling
ts_label <- ctest_s$Conversion #menggunakan data yang sudah di scaling
new_tr <- model.matrix(~.+0,data = ctrain_s[,-18])
new_ts <- model.matrix(~.+0,data = ctest_s[,-16])#preparing matrix
library(xgboost)
dtrain_c <- xgb.DMatrix(data = new_tr,label = labels)
dtest_c <- xgb.DMatrix(data = new_ts,label = ts_label)#default parameters
params <- list(booster = "gbtree", objective = "binary:logistic", eta=0.3, gamma=0, max_depth=6, min_child_weight=1, subsample=1, colsample_bytree=1)xgbcv <- xgb.cv( params = params, data = dtrain_c, nrounds = 500, nfold = 5, showsd = T, stratified = T, print.every.n = 10, early.stop.round = 20, maximize = F)## [1] train-logloss:0.597259+0.001454 test-logloss:0.607227+0.002469
## Multiple eval metrics are present. Will use test_logloss for early stopping.
## Will train until test_logloss hasn't improved in 20 rounds.
##
## [11] train-logloss:0.306200+0.006079 test-logloss:0.355354+0.009149
## [21] train-logloss:0.212210+0.007402 test-logloss:0.275863+0.005721
## [31] train-logloss:0.152260+0.006231 test-logloss:0.221053+0.007692
## [41] train-logloss:0.114494+0.005757 test-logloss:0.185621+0.010154
## [51] train-logloss:0.087469+0.006637 test-logloss:0.158339+0.010624
## [61] train-logloss:0.067694+0.002916 test-logloss:0.138502+0.009126
## [71] train-logloss:0.052226+0.002802 test-logloss:0.120899+0.010017
## [81] train-logloss:0.041371+0.001949 test-logloss:0.109331+0.009386
## [91] train-logloss:0.033379+0.001690 test-logloss:0.100229+0.010205
## [101] train-logloss:0.026839+0.001521 test-logloss:0.092383+0.010688
## [111] train-logloss:0.022126+0.000801 test-logloss:0.086942+0.010588
## [121] train-logloss:0.018521+0.000783 test-logloss:0.082757+0.011597
## [131] train-logloss:0.015696+0.000633 test-logloss:0.079914+0.011905
## [141] train-logloss:0.013637+0.000553 test-logloss:0.077600+0.012455
## [151] train-logloss:0.012022+0.000518 test-logloss:0.076008+0.012941
## [161] train-logloss:0.010563+0.000444 test-logloss:0.074144+0.012553
## [171] train-logloss:0.009449+0.000326 test-logloss:0.072728+0.013083
## [181] train-logloss:0.008470+0.000363 test-logloss:0.071547+0.012774
## [191] train-logloss:0.007585+0.000320 test-logloss:0.070539+0.013322
## [201] train-logloss:0.006873+0.000303 test-logloss:0.070627+0.013511
## [211] train-logloss:0.006241+0.000242 test-logloss:0.069863+0.013538
## [221] train-logloss:0.005755+0.000218 test-logloss:0.069470+0.013958
## [231] train-logloss:0.005277+0.000161 test-logloss:0.069190+0.014302
## [241] train-logloss:0.004904+0.000130 test-logloss:0.069077+0.014570
## [251] train-logloss:0.004607+0.000122 test-logloss:0.068893+0.014778
## [261] train-logloss:0.004321+0.000105 test-logloss:0.068542+0.014955
## [271] train-logloss:0.004062+0.000085 test-logloss:0.068707+0.015004
## [281] train-logloss:0.003814+0.000085 test-logloss:0.068568+0.014933
## Stopping. Best iteration:
## [261] train-logloss:0.004321+0.000105 test-logloss:0.068542+0.014955
## [1] 261
#model tuning
cxgb_tune <- xgb.train (params = params, data = dtrain_c, nrounds = best_iter, maximize = F , eval_metric = "error")
# save model
saveRDS(cxgb_tune, "cxgb_tune.RDS")#model prediction on data test
xgbpred_tune_test <- predict (cxgb_tune, dtest_c)
xgbpred_tune_test <- ifelse (xgbpred_tune_test > 0.5,1,0)
#model prediction on data train
xgbpred_tune_train <- predict (cxgb_tune, dtrain_c)
xgbpred_tune_train <- ifelse (xgbpred_tune_train > 0.5,1,0)Evaluation
#confusion matrix data train
cxgb_train_tune <- confusionMatrix(data = as.factor(xgbpred_tune_train),
reference = as.factor(labels),
positive = "1",
mode = "everything")
cxgb_train_tune## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 5601 0
## 1 0 5601
##
## Accuracy : 1
## 95% CI : (0.9997, 1)
## No Information Rate : 0.5
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 1
##
## Mcnemar's Test P-Value : NA
##
## Sensitivity : 1.0
## Specificity : 1.0
## Pos Pred Value : 1.0
## Neg Pred Value : 1.0
## Precision : 1.0
## Recall : 1.0
## F1 : 1.0
## Prevalence : 0.5
## Detection Rate : 0.5
## Detection Prevalence : 0.5
## Balanced Accuracy : 1.0
##
## 'Positive' Class : 1
##
#confusion matrix data test
cxgb_test_tune <- confusionMatrix(data = as.factor(xgbpred_tune_test),
reference = as.factor(ts_label),
positive = "1",
mode = "everything")
cxgb_test_tune## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 66 37
## 1 123 1374
##
## Accuracy : 0.9
## 95% CI : (0.8842, 0.9143)
## No Information Rate : 0.8819
## P-Value [Acc > NIR] : 0.01226
##
## Kappa : 0.4022
##
## Mcnemar's Test P-Value : 1.819e-11
##
## Sensitivity : 0.9738
## Specificity : 0.3492
## Pos Pred Value : 0.9178
## Neg Pred Value : 0.6408
## Precision : 0.9178
## Recall : 0.9738
## F1 : 0.9450
## Prevalence : 0.8819
## Detection Rate : 0.8588
## Detection Prevalence : 0.9356
## Balanced Accuracy : 0.6615
##
## 'Positive' Class : 1
##
eval_c_xgbtune <- data_frame(Model = "XGBTune",
Accuracy_Train = cxgb_train_tune$overall[1],
Accuracy_Test = cxgb_test_tune$overall[1],
Selisih_Accuracy = (Accuracy_Test-Accuracy_Train),
Recall_Train = cxgb_train_tune$byClass[1],
Recall_Test = cxgb_test_tune$byClass[1],
Selisih_Recall = (Recall_Test-Recall_Train),
Precision_Train = cxgb_train_tune$byClass[3],
Precision_Test = cxgb_test_tune$byClass[3],
Selisih_Precision = (Precision_Test-Precision_Train))
eval_c_xgbtunesummary_classtune <- rbind(eval_c_log, eval_c_forest, eval_c_bayes, eval_c_xgb, eval_c_foresttune, eval_c_xgbtune)
summary_classtune# define regression model parameters
params_tune = list(
objective = "regression",
metric = "l1", min_data = 1L, learning_rate = 0.01, num_iterations = 500,
num_leaves = 30, min_data_in_leaf = 100 )
# validataion data
valids = list(test = test_matrix1)# train lgbm reg model
lgbmr_tune = lgb.train(
params = params_tune,
data = train_matrix1,
nrounds = 200,
valids = valids)## [LightGBM] [Warning] min_data_in_leaf is set=100, min_data=1 will be ignored. Current value: min_data_in_leaf=100
## [LightGBM] [Warning] min_data_in_leaf is set=100, min_data=1 will be ignored. Current value: min_data_in_leaf=100
## [LightGBM] [Warning] min_data_in_leaf is set=100, min_data=1 will be ignored. Current value: min_data_in_leaf=100
## [LightGBM] [Warning] min_data_in_leaf is set=100, min_data=1 will be ignored. Current value: min_data_in_leaf=100
## [LightGBM] [Warning] min_data_in_leaf is set=100, min_data=1 will be ignored. Current value: min_data_in_leaf=100
## [LightGBM] [Info] Auto-choosing col-wise multi-threading, the overhead of testing was 0.001130 seconds.
## You can set `force_col_wise=true` to remove the overhead.
## [LightGBM] [Info] Total Bins 1804
## [LightGBM] [Info] Number of data points in the train set: 6400, number of used features: 25
## [LightGBM] [Info] Start training from score 0.155100
## [1]: test's l1:0.0714733
## [2]: test's l1:0.0714751
## [3]: test's l1:0.0714772
## [4]: test's l1:0.0714776
## [5]: test's l1:0.0714837
## [6]: test's l1:0.071487
## [7]: test's l1:0.0714896
## [8]: test's l1:0.0714929
## [9]: test's l1:0.0714941
## [10]: test's l1:0.0714972
## [11]: test's l1:0.0715001
## [12]: test's l1:0.0715021
## [13]: test's l1:0.0715051
## [14]: test's l1:0.0715069
## [15]: test's l1:0.071507
## [16]: test's l1:0.0715089
## [17]: test's l1:0.0715108
## [18]: test's l1:0.071514
## [19]: test's l1:0.0715124
## [20]: test's l1:0.0715092
## [21]: test's l1:0.0715109
## [22]: test's l1:0.0715109
## [23]: test's l1:0.0715104
## [24]: test's l1:0.0715138
## [25]: test's l1:0.0715177
## [26]: test's l1:0.071516
## [27]: test's l1:0.0715172
## [28]: test's l1:0.0715217
## [29]: test's l1:0.0715249
## [30]: test's l1:0.0715261
## [31]: test's l1:0.0715261
## [32]: test's l1:0.0715274
## [33]: test's l1:0.0715301
## [34]: test's l1:0.0715313
## [35]: test's l1:0.0715299
## [36]: test's l1:0.0715347
## [37]: test's l1:0.0715369
## [38]: test's l1:0.0715359
## [39]: test's l1:0.0715406
## [40]: test's l1:0.0715435
## [41]: test's l1:0.0715433
## [42]: test's l1:0.0715431
## [43]: test's l1:0.07154
## [44]: test's l1:0.0715454
## [45]: test's l1:0.0715468
## [46]: test's l1:0.0715464
## [47]: test's l1:0.0715502
## [48]: test's l1:0.0715536
## [49]: test's l1:0.071557
## [50]: test's l1:0.0715562
## [51]: test's l1:0.0715579
## [52]: test's l1:0.0715609
## [53]: test's l1:0.0715662
## [54]: test's l1:0.071565
## [55]: test's l1:0.0715631
## [56]: test's l1:0.0715636
## [57]: test's l1:0.0715664
## [58]: test's l1:0.0715646
## [59]: test's l1:0.0715649
## [60]: test's l1:0.0715674
## [61]: test's l1:0.0715666
## [62]: test's l1:0.0715673
## [63]: test's l1:0.0715667
## [64]: test's l1:0.0715685
## [65]: test's l1:0.0715748
## [66]: test's l1:0.0715739
## [67]: test's l1:0.0715769
## [68]: test's l1:0.0715789
## [69]: test's l1:0.07158
## [70]: test's l1:0.0715828
## [71]: test's l1:0.0715823
## [72]: test's l1:0.0715843
## [73]: test's l1:0.0715829
## [74]: test's l1:0.0715833
## [75]: test's l1:0.0715847
## [76]: test's l1:0.0715858
## [77]: test's l1:0.0715849
## [78]: test's l1:0.0715802
## [79]: test's l1:0.0715819
## [80]: test's l1:0.0715794
## [81]: test's l1:0.0715795
## [82]: test's l1:0.0715827
## [83]: test's l1:0.0715817
## [84]: test's l1:0.0715805
## [85]: test's l1:0.0715795
## [86]: test's l1:0.0715808
## [87]: test's l1:0.0715784
## [88]: test's l1:0.0715785
## [89]: test's l1:0.0715813
## [90]: test's l1:0.0715804
## [91]: test's l1:0.0715794
## [92]: test's l1:0.0715745
## [93]: test's l1:0.0715757
## [94]: test's l1:0.0715742
## [95]: test's l1:0.0715741
## [96]: test's l1:0.0715747
## [97]: test's l1:0.0715702
## [98]: test's l1:0.0715724
## [99]: test's l1:0.0715736
## [100]: test's l1:0.071569
## [101]: test's l1:0.0715651
## [102]: test's l1:0.0715677
## [103]: test's l1:0.0715697
## [104]: test's l1:0.0715646
## [105]: test's l1:0.0715682
## [106]: test's l1:0.0715673
## [107]: test's l1:0.0715632
## [108]: test's l1:0.0715655
## [109]: test's l1:0.0715663
## [110]: test's l1:0.0715628
## [111]: test's l1:0.071569
## [112]: test's l1:0.0715658
## [113]: test's l1:0.0715686
## [114]: test's l1:0.0715683
## [115]: test's l1:0.0715716
## [116]: test's l1:0.0715693
## [117]: test's l1:0.071571
## [118]: test's l1:0.0715734
## [119]: test's l1:0.0715738
## [120]: test's l1:0.0715774
## [121]: test's l1:0.0715775
## [122]: test's l1:0.0715803
## [123]: test's l1:0.0715792
## [124]: test's l1:0.0715848
## [125]: test's l1:0.0715845
## [126]: test's l1:0.0715851
## [127]: test's l1:0.0715863
## [128]: test's l1:0.0715843
## [129]: test's l1:0.0715844
## [130]: test's l1:0.0715853
## [131]: test's l1:0.0715856
## [132]: test's l1:0.0715872
## [133]: test's l1:0.0715852
## [134]: test's l1:0.0715849
## [135]: test's l1:0.0715855
## [136]: test's l1:0.071585
## [137]: test's l1:0.0715849
## [138]: test's l1:0.0715871
## [139]: test's l1:0.0715883
## [140]: test's l1:0.0715858
## [141]: test's l1:0.0715858
## [142]: test's l1:0.0715871
## [143]: test's l1:0.0715895
## [144]: test's l1:0.0715879
## [145]: test's l1:0.0715916
## [146]: test's l1:0.0715926
## [147]: test's l1:0.0715951
## [148]: test's l1:0.071595
## [149]: test's l1:0.071599
## [150]: test's l1:0.0716
## [151]: test's l1:0.0716024
## [152]: test's l1:0.0716021
## [153]: test's l1:0.0716032
## [154]: test's l1:0.0716052
## [155]: test's l1:0.0716075
## [156]: test's l1:0.0716081
## [157]: test's l1:0.071609
## [158]: test's l1:0.0716122
## [159]: test's l1:0.0716175
## [160]: test's l1:0.0716167
## [161]: test's l1:0.0716218
## [162]: test's l1:0.0716242
## [163]: test's l1:0.0716258
## [164]: test's l1:0.0716204
## [165]: test's l1:0.0716255
## [166]: test's l1:0.0716289
## [167]: test's l1:0.0716276
## [168]: test's l1:0.0716317
## [169]: test's l1:0.0716307
## [170]: test's l1:0.0716311
## [171]: test's l1:0.0716329
## [172]: test's l1:0.0716363
## [173]: test's l1:0.0716386
## [174]: test's l1:0.0716398
## [175]: test's l1:0.0716385
## [176]: test's l1:0.0716399
## [177]: test's l1:0.0716412
## [178]: test's l1:0.0716407
## [179]: test's l1:0.071642
## [180]: test's l1:0.0716416
## [181]: test's l1:0.0716447
## [182]: test's l1:0.0716462
## [183]: test's l1:0.0716471
## [184]: test's l1:0.0716486
## [185]: test's l1:0.0716512
## [186]: test's l1:0.0716537
## [187]: test's l1:0.0716531
## [188]: test's l1:0.0716546
## [189]: test's l1:0.071657
## [190]: test's l1:0.0716575
## [191]: test's l1:0.0716574
## [192]: test's l1:0.0716596
## [193]: test's l1:0.071664
## [194]: test's l1:0.0716599
## [195]: test's l1:0.0716611
## [196]: test's l1:0.0716559
## [197]: test's l1:0.0716545
## [198]: test's l1:0.0716556
## [199]: test's l1:0.071655
## [200]: test's l1:0.0716583
## [201]: test's l1:0.0716592
## [202]: test's l1:0.0716637
## [203]: test's l1:0.0716632
## [204]: test's l1:0.0716678
## [205]: test's l1:0.0716686
## [206]: test's l1:0.0716707
## [207]: test's l1:0.0716688
## [208]: test's l1:0.0716686
## [209]: test's l1:0.07167
## [210]: test's l1:0.0716705
## [211]: test's l1:0.0716751
## [212]: test's l1:0.071676
## [213]: test's l1:0.071681
## [214]: test's l1:0.0716791
## [215]: test's l1:0.0716798
## [216]: test's l1:0.0716777
## [217]: test's l1:0.0716753
## [218]: test's l1:0.0716781
## [219]: test's l1:0.071679
## [220]: test's l1:0.0716831
## [221]: test's l1:0.0716832
## [222]: test's l1:0.0716851
## [223]: test's l1:0.0716833
## [224]: test's l1:0.0716816
## [225]: test's l1:0.0716851
## [226]: test's l1:0.0716865
## [227]: test's l1:0.0716905
## [228]: test's l1:0.0716909
## [229]: test's l1:0.0716941
## [230]: test's l1:0.0716931
## [231]: test's l1:0.0716883
## [232]: test's l1:0.0716901
## [233]: test's l1:0.0716945
## [234]: test's l1:0.0716967
## [235]: test's l1:0.0716977
## [236]: test's l1:0.0717018
## [237]: test's l1:0.0717052
## [238]: test's l1:0.0717005
## [239]: test's l1:0.071702
## [240]: test's l1:0.0716995
## [241]: test's l1:0.0717018
## [242]: test's l1:0.0717046
## [243]: test's l1:0.0717045
## [244]: test's l1:0.0717021
## [245]: test's l1:0.0717025
## [246]: test's l1:0.0717036
## [247]: test's l1:0.0717078
## [248]: test's l1:0.071709
## [249]: test's l1:0.0717059
## [250]: test's l1:0.0717126
## [251]: test's l1:0.071718
## [252]: test's l1:0.07172
## [253]: test's l1:0.0717188
## [254]: test's l1:0.0717206
## [255]: test's l1:0.0717238
## [256]: test's l1:0.0717284
## [257]: test's l1:0.0717253
## [258]: test's l1:0.0717251
## [259]: test's l1:0.0717236
## [260]: test's l1:0.0717261
## [261]: test's l1:0.0717273
## [262]: test's l1:0.0717252
## [263]: test's l1:0.0717305
## [264]: test's l1:0.0717303
## [265]: test's l1:0.071731
## [266]: test's l1:0.0717328
## [267]: test's l1:0.0717382
## [268]: test's l1:0.071739
## [269]: test's l1:0.0717435
## [270]: test's l1:0.0717463
## [271]: test's l1:0.0717489
## [272]: test's l1:0.0717496
## [273]: test's l1:0.071748
## [274]: test's l1:0.0717471
## [275]: test's l1:0.0717546
## [276]: test's l1:0.0717542
## [277]: test's l1:0.071756
## [278]: test's l1:0.0717574
## [279]: test's l1:0.07176
## [280]: test's l1:0.0717623
## [281]: test's l1:0.0717643
## [282]: test's l1:0.0717636
## [283]: test's l1:0.0717668
## [284]: test's l1:0.0717652
## [285]: test's l1:0.0717685
## [286]: test's l1:0.0717686
## [287]: test's l1:0.0717669
## [288]: test's l1:0.0717687
## [289]: test's l1:0.0717699
## [290]: test's l1:0.0717719
## [291]: test's l1:0.0717708
## [292]: test's l1:0.0717718
## [293]: test's l1:0.0717711
## [294]: test's l1:0.071773
## [295]: test's l1:0.0717777
## [296]: test's l1:0.0717785
## [297]: test's l1:0.0717781
## [298]: test's l1:0.0717804
## [299]: test's l1:0.0717803
## [300]: test's l1:0.0717856
## [301]: test's l1:0.0717848
## [302]: test's l1:0.071781
## [303]: test's l1:0.071787
## [304]: test's l1:0.0717884
## [305]: test's l1:0.0717918
## [306]: test's l1:0.0717913
## [307]: test's l1:0.0717927
## [308]: test's l1:0.0717955
## [309]: test's l1:0.0717964
## [310]: test's l1:0.0717967
## [311]: test's l1:0.071799
## [312]: test's l1:0.0717956
## [313]: test's l1:0.0717987
## [314]: test's l1:0.0717952
## [315]: test's l1:0.071798
## [316]: test's l1:0.0717968
## [317]: test's l1:0.0717956
## [318]: test's l1:0.0717975
## [319]: test's l1:0.0718005
## [320]: test's l1:0.0717961
## [321]: test's l1:0.0717963
## [322]: test's l1:0.0717992
## [323]: test's l1:0.071796
## [324]: test's l1:0.0717933
## [325]: test's l1:0.0717934
## [326]: test's l1:0.0717943
## [327]: test's l1:0.0717958
## [328]: test's l1:0.071796
## [329]: test's l1:0.0717955
## [330]: test's l1:0.0717972
## [331]: test's l1:0.0717995
## [332]: test's l1:0.0718015
## [333]: test's l1:0.0718037
## [334]: test's l1:0.071803
## [335]: test's l1:0.0718051
## [336]: test's l1:0.0718041
## [337]: test's l1:0.0718048
## [338]: test's l1:0.0718023
## [339]: test's l1:0.0718044
## [340]: test's l1:0.0718067
## [341]: test's l1:0.071809
## [342]: test's l1:0.0718096
## [343]: test's l1:0.0718062
## [344]: test's l1:0.0718084
## [345]: test's l1:0.0718131
## [346]: test's l1:0.0718065
## [347]: test's l1:0.0718058
## [348]: test's l1:0.071806
## [349]: test's l1:0.0718043
## [350]: test's l1:0.0718045
## [351]: test's l1:0.0718025
## [352]: test's l1:0.0717991
## [353]: test's l1:0.0717977
## [354]: test's l1:0.0718012
## [355]: test's l1:0.0718018
## [356]: test's l1:0.0717959
## [357]: test's l1:0.0717989
## [358]: test's l1:0.071798
## [359]: test's l1:0.0718014
## [360]: test's l1:0.0717962
## [361]: test's l1:0.0717985
## [362]: test's l1:0.0717961
## [363]: test's l1:0.071801
## [364]: test's l1:0.0717997
## [365]: test's l1:0.0717947
## [366]: test's l1:0.07179
## [367]: test's l1:0.0717895
## [368]: test's l1:0.0717893
## [369]: test's l1:0.071786
## [370]: test's l1:0.0717861
## [371]: test's l1:0.0717844
## [372]: test's l1:0.0717818
## [373]: test's l1:0.0717821
## [374]: test's l1:0.0717853
## [375]: test's l1:0.0717825
## [376]: test's l1:0.0717853
## [377]: test's l1:0.0717812
## [378]: test's l1:0.0717802
## [379]: test's l1:0.071775
## [380]: test's l1:0.0717716
## [381]: test's l1:0.0717684
## [382]: test's l1:0.0717696
## [383]: test's l1:0.071768
## [384]: test's l1:0.0717624
## [385]: test's l1:0.0717674
## [386]: test's l1:0.0717734
## [387]: test's l1:0.0717714
## [388]: test's l1:0.0717677
## [389]: test's l1:0.0717603
## [390]: test's l1:0.0717583
## [391]: test's l1:0.0717582
## [392]: test's l1:0.0717571
## [393]: test's l1:0.0717613
## [394]: test's l1:0.0717553
## [395]: test's l1:0.0717612
## [396]: test's l1:0.0717655
## [397]: test's l1:0.0717652
## [398]: test's l1:0.0717683
## [399]: test's l1:0.0717684
## [400]: test's l1:0.0717715
## [401]: test's l1:0.0717746
## [402]: test's l1:0.0717697
## [403]: test's l1:0.0717659
## [404]: test's l1:0.0717716
## [405]: test's l1:0.0717666
## [406]: test's l1:0.0717716
## [407]: test's l1:0.0717656
## [408]: test's l1:0.0717696
## [409]: test's l1:0.071767
## [410]: test's l1:0.0717716
## [411]: test's l1:0.071772
## [412]: test's l1:0.0717743
## [413]: test's l1:0.0717744
## [414]: test's l1:0.0717781
## [415]: test's l1:0.0717785
## [416]: test's l1:0.0717786
## [417]: test's l1:0.0717714
## [418]: test's l1:0.0717701
## [419]: test's l1:0.0717709
## [420]: test's l1:0.0717691
## [421]: test's l1:0.0717673
## [422]: test's l1:0.0717602
## [423]: test's l1:0.0717588
## [424]: test's l1:0.0717569
## [425]: test's l1:0.0717519
## [426]: test's l1:0.0717521
## [427]: test's l1:0.0717538
## [428]: test's l1:0.0717549
## [429]: test's l1:0.0717558
## [430]: test's l1:0.0717565
## [431]: test's l1:0.0717538
## [432]: test's l1:0.0717528
## [433]: test's l1:0.0717478
## [434]: test's l1:0.0717486
## [435]: test's l1:0.0717478
## [436]: test's l1:0.0717476
## [437]: test's l1:0.0717502
## [438]: test's l1:0.0717477
## [439]: test's l1:0.071747
## [440]: test's l1:0.0717475
## [441]: test's l1:0.0717474
## [442]: test's l1:0.0717471
## [443]: test's l1:0.0717469
## [444]: test's l1:0.0717474
## [445]: test's l1:0.0717501
## [446]: test's l1:0.0717508
## [447]: test's l1:0.0717514
## [448]: test's l1:0.0717541
## [449]: test's l1:0.071755
## [450]: test's l1:0.0717564
## [451]: test's l1:0.0717528
## [452]: test's l1:0.0717536
## [453]: test's l1:0.0717576
## [454]: test's l1:0.0717514
## [455]: test's l1:0.0717525
## [456]: test's l1:0.0717533
## [457]: test's l1:0.0717498
## [458]: test's l1:0.0717521
## [459]: test's l1:0.0717519
## [460]: test's l1:0.0717528
## [461]: test's l1:0.0717491
## [462]: test's l1:0.0717459
## [463]: test's l1:0.0717451
## [464]: test's l1:0.071745
## [465]: test's l1:0.0717452
## [466]: test's l1:0.0717453
## [467]: test's l1:0.0717462
## [468]: test's l1:0.0717447
## [469]: test's l1:0.0717439
## [470]: test's l1:0.071745
## [471]: test's l1:0.0717484
## [472]: test's l1:0.0717504
## [473]: test's l1:0.0717535
## [474]: test's l1:0.071753
## [475]: test's l1:0.0717521
## [476]: test's l1:0.0717552
## [477]: test's l1:0.0717563
## [478]: test's l1:0.0717578
## [479]: test's l1:0.0717568
## [480]: test's l1:0.0717583
## [481]: test's l1:0.0717604
## [482]: test's l1:0.0717614
## [483]: test's l1:0.0717611
## [484]: test's l1:0.0717634
## [485]: test's l1:0.0717663
## [486]: test's l1:0.071766
## [487]: test's l1:0.071769
## [488]: test's l1:0.0717666
## [489]: test's l1:0.0717697
## [490]: test's l1:0.0717687
## [491]: test's l1:0.0717693
## [492]: test's l1:0.0717679
## [493]: test's l1:0.0717666
## [494]: test's l1:0.0717716
## [495]: test's l1:0.0717704
## [496]: test's l1:0.0717733
## [497]: test's l1:0.0717775
## [498]: test's l1:0.0717778
## [499]: test's l1:0.0717798
## [500]: test's l1:0.0717817
Prediction
# prediction
pred_testxgbtune = predict(lgbmr_tune, testm1)
pred_trainxgbtune = predict(lgbmr_tune, trainm1)
head(pred_testxgbtune)## 5 15 16 17 23 31
## 0.1553466 0.1552116 0.1550998 0.1548936 0.1549589 0.1549801
Evaluation
eval_r_lgbmtune <- data_frame(Model = "LGBMTune",
MAE_train = MAE(pred_trainxgbtune , rtrain_s$ClickThroughRate),
MAE_test = MAE(pred_testxgbtune , rtest_s$ClickThroughRate),
Selisih_MAE = (MAE_test-MAE_train),
RMSE_train = RMSE(pred_trainxgbtune , rtrain_s$ClickThroughRate),
RMSE_test = RMSE(pred_testxgbtune , rtest_s$ClickThroughRate),
Selisih_RMSE = (RMSE_test-RMSE_train))
eval_r_lgbmtuneModel Tuning model using recipe
#using tidymodels - parsnip package
xgbr_tune <- boost_tree(trees = tune()) %>%
set_mode("regression") %>%
set_engine("xgboost")# 2. Define recipe
rcp <- recipe(ClickThroughRate ~ ., data = rtrain_s) %>%
step_dummy(Gender, CampaignChannel, CampaignType, Age_cat, Income_cat) #merubah kolom faktor menjadi numerik## # Trees (quantitative)
## Range: [1, 2000]
# 6. Tune the model using the specified range for trees
tuning_results <- tune_grid(
xgb_wflow,
grid = trees_values,
resamples = vfold_cv(rtrain_s, v = 5),
metrics = mae_res
)#using tidymodels - parsnip package
rmodel_xgbtune <- boost_tree(trees = show_best$trees) %>%
set_mode("regression") %>%
set_engine("xgboost") %>%
fit(ClickThroughRate ~ ., data = rtrain_s)
# save model
saveRDS(rmodel_xgbtune, "rmodel_xgbtune.RDS")Prediction
# prediction on training data and testing data with model from tidymodels
xgbr_train_predtune <- predict(object = rmodel_xgbtune, new_data = rtrain_s)
xgbr_test_predtune <- predict(object = rmodel_xgbtune, new_data = rtest_s)Evaluation
eval_r_xgbtune <- data_frame(Model = "XGBTune",
MAE_train = MAE(xgbr_train_predtune$.pred, rtrain_s$ClickThroughRate),
MAE_test = MAE(xgbr_test_predtune$.pred, rtest_s$ClickThroughRate),
Selisih_MAE = (MAE_test-MAE_train),
RMSE_train = RMSE(xgbr_train_predtune$.pred, rtrain_s$ClickThroughRate),
RMSE_test = RMSE(xgbr_test_predtune$.pred, rtest_s$ClickThroughRate),
Selisih_RMSE = (RMSE_test-RMSE_train)
)
eval_r_xgbtunesummary_regressiontune <- rbind(eval_r_linear, eval_r_rf1, eval_r_lgbm, eval_r_xgb, eval_r_lgbmtune ,eval_r_xgbtune)
summary_regressiontuneModel prediktif yang kompleks tidak mudah diinterpretasikan seprti random forest, xgboost, deep learning, dll.
Dengan kata lain, jika diberikan prediksi tertentu, seperti kemungkinan membeli = 90%, apa pengaruh setiap variabel input untuk mendapatkan skor tersebut?
Teknik terbaru untuk menginterpretasikan model black-box tersebut yaitu SHAP (SHapley Additive exPlanations) yang dikembangkan oleh Scott M. Lundberg.
Bayangkan sebuah model skor penjualan. Seorang pelanggan yang tinggal di kode pos “A1” dengan “10 pembelian” datang dan skornya adalah 95%, sementara pelanggan lain dari kode pos “A2” dan “7 pembelian” memiliki skor 60%. Setiap variabel memiliki kontribusi terhadap skor akhir. Mungkin sedikit perubahan dalam jumlah pembelian mengubah skor secara signifikan, sementara perubahan kode pos hanya memberikan kontribusi yang sangat kecil pada pelanggan tertentu tersebut.
Nilai Shapley menghitung pentingnya suatu fitur dengan membandingkan apa yang diprediksi model dengan dan tanpa fitur tersebut. Akan tetapi, karena urutan model melihat fitur dapat memengaruhi prediksinya, hal ini dilakukan dalam setiap urutan yang memungkinkan, sehingga fitur-fitur tersebut dapat dibandingkan secara adil.
Classification
## Age Income AdSpend ConversionRate WebsiteVisits PagesPerVisit
## 1 -1.1145090 -0.8613459 0.05360432 -1.5396202 -0.6320981 -0.8089981
## 2 0.8869439 -1.1853368 -0.98954812 0.6869750 -1.3035915 1.0040919
## 3 0.3532231 -1.3282353 -1.26464383 -0.3655673 0.7780380 -1.0578048
## 4 -1.3813693 -0.6191540 -0.21082981 1.4519392 1.3823820 0.5807517
## 5 0.9536590 1.4023344 -0.96036611 1.3758310 -0.6320981 0.9422157
## 6 -0.5807882 0.3687632 -0.32632435 1.5916476 1.3823820 -1.4063986
## TimeOnSite SocialShares EmailOpens EmailClicks PreviousPurchases
## 1 0.5680955 -0.4151233 1.0876872 1.3823137 -1.3527028
## 2 -0.9451878 0.1720071 -0.2920288 0.3392701 -1.0192746
## 3 -0.6529588 -0.8295683 1.0876872 -1.3991359 -1.3527028
## 4 -0.1406038 0.6900634 1.6050808 -0.3560923 0.3144381
## 5 -0.5439558 -1.0713279 -0.6369578 -0.3560923 -1.0192746
## 6 -0.3692516 -1.1058650 -0.2920288 -1.3991359 -1.0192746
## LoyaltyPoints GenderFemale GenderMale CampaignChannelPPC
## 1 -1.2478870 0 1 0
## 2 -1.5065235 1 0 0
## 3 1.5211649 0 1 0
## 4 -0.3385542 1 0 0
## 5 0.9306802 1 0 0
## 6 -0.2612369 1 0 0
## CampaignChannelReferral CampaignChannelSEO CampaignChannelSocial Media
## 1 0 0 0
## 2 1 0 0
## 3 0 1 0
## 4 1 0 0
## 5 1 0 0
## 6 0 0 0
## CampaignTypeConsideration CampaignTypeConversion CampaignTypeRetention
## 1 1 0 0
## 2 0 0 1
## 3 0 0 0
## 4 1 0 0
## 5 0 0 1
## 6 0 0 1
## Age_catGen X Age_catGen Y Age_catGen Z Income_cat100.001-150.000
## 1 0 0 1 0
## 2 1 0 0 0
## 3 1 0 0 0
## 4 0 0 1 0
## 5 1 0 0 1
## 6 0 1 0 0
## Income_cat50.001-100.000
## 1 1
## 2 0
## 3 0
## 4 1
## 5 0
## 6 1
library(SHAPforxgboost)
# Crunch SHAP values
#shap <- shap.prep(fit1, X_train = X1)
shap <- shap.prep(cxgb_tune, X_train = X1)
# SHAP importance plot
shap.plot.summary(shap)Interpretasi:
- Pada sumbu y ditunjukkan variabel-variabel yang digunakan. Variabel
yang berada paling atas adalah variabel yang paling penting atau
berpengaruh dan urut ke bawah sesuai dengan tingkat pengaruh variabel.
Variabel yang paling berpengaruh yaitu PreviousPurchases dengan
rata-rata nilai SHAP 1.235.
- Pada sumbu x adalah nilai SHAP. Menunjukkan seberapa besar perubahan
dalam log-odds. Dari angka ini kita dapat mengekstrak probabilitas
konsumen akan membeli.
- Warna gradien menunjukkan nilai asli untuk variabel tersebut. Dalam
boolean, akan dibutuhkan dua warna, tetapi dalam angka dapat berisi
seluruh spektrum. Setiap titik mewakili baris dari kumpulan data
asli.
Regression
#Calculate shap values
library(SHAPforxgboost)
X2 = data.matrix(rtrain_s[,-18]) #Drop kolom ClickThroughRate pada data train
head(X2)## Age Income AdSpend ConversionRate WebsiteVisits
## 2463 0.1539135 1.70221737 0.6454833 1.5295643 -1.37838723
## 2062 0.4227397 1.67513593 0.5781503 -1.5312030 1.06802103
## 4418 -0.2493258 -0.62498398 -1.3851978 0.3069213 0.08945772
## 451 -0.3165323 0.70963780 -1.6485100 -0.1511016 -0.19013179
## 3747 -0.9885978 -0.50044119 1.5145450 0.7368879 -1.30848985
## 3868 -1.5262501 0.03607327 -0.4853226 -1.0562653 0.50884200
## PagesPerVisit TimeOnSite SocialShares EmailOpens EmailClicks
## 2463 0.5820079 1.51223131 -0.8945254 -1.1305263 1.6016518
## 2062 -0.8283450 0.26873853 -1.1718003 -0.4333598 -1.2008694
## 4418 0.7678013 0.03816663 1.1503765 0.9609733 0.5507063
## 451 0.9843392 -0.25837954 -1.0331629 0.2638067 0.9010215
## 3747 -0.6343710 1.59141577 1.1157171 0.9609733 0.5507063
## 3868 0.4857872 -1.57611657 -0.4786132 -0.4333598 0.2003912
## PreviousPurchases LoyaltyPoints Gender CampaignChannel CampaignType
## 2463 0.1968848 -1.6976856 2 2 3
## 2062 0.5432462 0.5774965 1 5 2
## 4418 0.5432462 -0.3769054 1 3 1
## 451 -1.5349221 -0.3783038 1 1 4
## 3747 0.8896075 1.2843831 2 1 1
## 3868 1.5823303 -1.6095870 2 4 3
## Age_cat Income_cat
## 2463 2 2
## 2062 2 2
## 4418 3 3
## 451 3 2
## 3747 3 3
## 3868 4 3
dtrain <- xgb.DMatrix(X2, label = rtrain_s[[18]])
fit2 <- xgb.train(
params = list(
objective = "reg:squarederror",
learning_rate = 0.1
),
data = dtrain,
nrounds = 50
)# Crunch SHAP values
shap <- shap.prep(fit2, X_train = X2)
# SHAP importance plot
shap.plot.summary(shap)Interpretasi:
- Variabel yang paling berpengaruh yaitu PagePerVisit dengan rata-rata
nilai SHAP 0.002.
- Pada sumbu x adalah nilai SHAP. Menunjukkan seberapa besar perubahan
dalam log-odds. Dari angka ini kita dapat mengekstrak probabilitas
konsumen akan membeli.
- Warna gradien menunjukkan nilai asli untuk variabel tersebut. Dalam
boolean, akan dibutuhkan dua warna, tetapi dalam angka dapat berisi
seluruh spektrum. Setiap titik mewakili baris dari kumpulan data
asli.
kategori_generasi <- c("Generasi", "Generasi", "Generasi", "Generasi")
demo_gen <- dm_clean %>% group_by(Age_cat) %>% summarise(Frekuensi = n()) %>% arrange(-Frekuensi)%>% cbind(kategori_generasi)
demo_gen <- demo_gen %>% rename(Parameter = Age_cat, Kategori = kategori_generasi)
demo_genkategori_gender <- c("Gender", "Gender")
demo_gender <- dm_clean %>% group_by(Gender) %>% summarise(Frekuensi = n())%>% cbind(kategori_gender)
demo_gender <- demo_gender %>% rename(Parameter = Gender, Kategori = kategori_gender)
demo_genderkategori_income <- c("Income", "Income", "Income")
demo_income <- dm_clean %>% group_by(Income_cat) %>% summarise(Frekuensi = n())%>% cbind(kategori_income) %>% arrange(-Frekuensi)
demo_income <- demo_income %>% rename(Parameter = Income_cat, Kategori = kategori_income)
demo_incomedemo <- rbind(demo_gen, demo_gender, demo_income)
cat_demo <- demo %>% filter(Kategori %in% "Generasi") %>%
mutate(label = glue("Frekuensi {Parameter} : {comma(Frekuensi)}"))
cat_demo# Pembuatan Visual Statis
plot_distdemografi <-
ggplot(data = cat_demo,
mapping = aes(x=reorder(Parameter, Frekuensi), y=Frekuensi , text=label)) +
geom_col(fill = "darkgreen")+
labs(title = "Distribusi Demografi Berdasarkan Generasi",
x = "Generasi",
y = "Frekuensi") +
scale_y_continuous(labels = comma) +
theme_classic()+
theme(plot.title = element_text(face = "bold", size = 14, hjust = 6))
# Mengubah Visual Statis menjadi Interaktif
ggplotly(plot_distdemografi, tooltip = 'text')Sebaran customer engagement variables berdasarkan generasi
kategori_melt <- c("Generasi", "Generasi", "Generasi", "Generasi", "Generasi", "Generasi",
"Generasi", "Generasi", "Generasi", "Generasi", "Generasi", "Generasi",
"Generasi", "Generasi", "Generasi", "Generasi", "Generasi", "Generasi",
"Generasi", "Generasi", "Generasi", "Generasi", "Generasi", "Generasi")
melt_gen <- cbind(Sum_CE, kategori_melt)
melt_gen <- melt_gen %>% rename(Parameter = Age_cat, Kategori = kategori_melt)
head(melt_gen,2)Sebaran customer engagement variables berdasarkan gender
kategori_melt2 <- c("Gender", "Gender", "Gender", "Gender", "Gender", "Gender",
"Gender", "Gender", "Gender", "Gender", "Gender", "Gender")
melt_gender <- cbind(Sum_CE2, kategori_melt2)
melt_gender <- melt_gender %>% rename(Parameter = Gender, Kategori = kategori_melt2)
head(melt_gender,2)Sebaran customer engagement variables berdasarkan income
kategori_melt3 <- c("Income", "Income", "Income", "Income", "Income", "Income",
"Income", "Income", "Income", "Income", "Income", "Income",
"Income", "Income", "Income", "Income", "Income", "Income")
melt_income <- cbind(Sum_CE3, kategori_melt3)
melt_income <- melt_income %>% rename(Parameter = Income_cat, Kategori = kategori_melt3)
head(melt_income,2)melt_all <- rbind(melt_gen, melt_gender, melt_income)
cat_engage <- melt_all %>% filter(Kategori %in% "Generasi") %>%
mutate(label = glue("Frekuensi {variable} {Parameter} : {comma(value)}"))
head(cat_engage,2)# Pembuatan Visual Statis
plot_engagement <-
ggplot(data = cat_engage,
mapping = aes(x = reorder(Parameter, value), y =value, fill = variable, text=label)) +
geom_col(mapping = aes(fill=variable), position = "dodge")+
labs(title = "Sebaran Customer Engagement Variable Berdasarkan Generasi",
x = "Generasi",
y = "Total") +
scale_y_continuous(labels = comma) +
theme_classic()+
theme(plot.title = element_text(face = "bold", size = 14, hjust = 6))
# Mengubah Visual Statis menjadi Interaktif
ggplotly(plot_engagement, tooltip = 'text')Model Klasifikasi
compare_cmodel <- summary_classtune %>%
select(-Selisih_Accuracy, -Selisih_Recall, -Selisih_Precision) %>%
melt(id = c("Model")) %>%
mutate(label = glue("{Model} {variable} : {comma(value)}"))
head(compare_cmodel,2)# Pembuatan Visual Statis
plot_cmodel <-
ggplot(data = compare_cmodel,
mapping = aes(x = Model, y =value, fill = variable, text=label)) +
geom_col(mapping = aes(fill=variable), position = "dodge")+
labs(title = "Perbandingan Performa Model Klasifikasi",
x = "Model",
y = "Nilai") +
theme_classic()+
theme(plot.title = element_text(face = "bold", size = 14, hjust = 6))
# Mengubah Visual Statis menjadi Interaktif
ggplotly(plot_cmodel, tooltip = 'text')Model Regresi
compare_rmodel <- summary_regressiontune %>%
select(-Selisih_MAE, -Selisih_RMSE) %>%
melt(id = c("Model")) %>%
mutate(label = glue("{Model} {variable} : {comma(value)}"))
head(compare_rmodel,2)# Pembuatan Visual Statis
plot_rmodel <-
ggplot(data = compare_rmodel,
mapping = aes(x = Model, y =value, fill = variable, text=label)) +
geom_col(mapping = aes(fill=variable), position = "dodge")+
labs(title = "Perbandingan Performa Model Regresi",
x = "Model",
y = "Nilai") +
theme_classic()+
theme(plot.title = element_text(face = "bold", size = 14, hjust = 6))
# Mengubah Visual Statis menjadi Interaktif
ggplotly(plot_rmodel, tooltip = 'text')1.
Apa itu industri 4.0 ?
2.
Tren digital 2024
3.
Strategi bisnis digital
4.
Transformasi digital marketing
5.
Marketing 6.0
6.
Menghadapi tantangan digital marketing di 2024
7.
Social media marketing challenges di tahun 2024
8.
Tiga tantangan yang kerap dihadapi oleh tim marketing
9.
Tantangan pemasaran
10.
Survey umkm lokal kesulitan memasarkan produk
11. Logistic
Regression
12. Linear
Regression
13.
Random Forest Algorithm
14.
Naive Bayes Classifier
15. Light
GBM
16. XG Boost
17.
Standar nilai CTR
18.
Usia 6 Generasi pada tahun 2024 19.
SHAP 20.
SHAP Github 21.
XGBoost Parameter 22.
Feature Scaling 23.
Feature Scaling 24.
Feature Scaling 25.
Random Forest Tuning https://www.hackerearth.com/practice/machine-learning/machine-learning-algorithms/beginners-tutorial-on-xgboost-parameter-tuning-r/tutorial/
27.
LightGBM Tuning