1 Background

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].

Nilai Pasar Generative AI 2020-2030 (sumber: www.kompas.id)
Nilai Pasar Generative AI 2020-2030 (sumber: www.kompas.id)


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].

Evolusi Marketing Dari 1.0 Hingga 6.0 (sumber: www.bms.telkomuniversity.ac.id)
Evolusi Marketing Dari 1.0 Hingga 6.0 (sumber: www.bms.telkomuniversity.ac.id)


Perbandingan Marketing Tradisional dan Marketing 6.0 (sumber: www.bms.telkomuniversity.ac.id)
Perbandingan Marketing Tradisional dan Marketing 6.0 (sumber: www.bms.telkomuniversity.ac.id)


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.

2 Problem Statement

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.

3 Project Idea

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)

  1. Logistic Regression Classifier
    Model linear yang digunakan untuk memecahkan masalah klasifikasi biner. Regresi logistik adalah algoritma statistik yang menganalisis hubungan antara dua faktor data. Regresi logistik cocok digunakan pada data besar dan tidak memiliki outlier. Regresi logistik merupakan salah satu teknik yang paling efisien untuk memecahkan masalah klasifikasi. Beberapa keuntungan menggunakan regresi logistik meliputi:
  • Regresi logistik lebih mudah diimplementasikan, diinterpretasikan, dan sangat efisien untuk dilatih. Regresi logistik sangat cepat dalam mengklasifikasikan data yang tidak diketahui.
  • Regresi logistik bekerja dengan baik jika kumpulan data dapat dipisahkan secara linier.
  • Regresi logistik dapat menginterpretasikan koefisien model sebagai indikator pentingnya fitur [11].
  1. 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].

  2. 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]

  3. 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].

  4. 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:

  • Kecepatan pelatihan yang lebih cepat dan efisiensi yang lebih tinggi.
  • Penggunaan memori yang lebih rendah.
  • Akurasi yang lebih baik.
  • Dukungan pembelajaran paralel dan terdistribusi.
  • Mampu menangani data berskala besar [15].
  1. XGBoost Classifier and Regressor
    XGBoost adalah pustaka penguat gradien terdistribusi yang dioptimalkan yang dirancang untuk pelatihan model machine learning yang efisien dan terukur. Ini adalah metode pembelajaran ensemble yang menggabungkan prediksi beberapa model lemah untuk menghasilkan prediksi yang lebih kuat. XGBoost adalah singkatan dari “Extreme Gradient Boosting” dan telah menjadi salah satu algoritma pembelajaran mesin yang paling populer dan banyak digunakan karena kemampuannya untuk menangani kumpulan data besar dan kemampuannya untuk mencapai kinerja mutakhir dalam banyak tugas pembelajaran mesin seperti klasifikasi dan regresi [16].

4 Problem Scope

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.

5 Output

Output dari project ini berupa dashboard analysis yang menampilkan hasil exploratory data mengenai proporsi umur, gender, campaign channel, dan campaign type. Selain itu, user juga dapat menginputkan informasi demografi konsumen, campaign type yang akan dijalani, campaign channel yang akan digunakan dan budget campaign, kemudian oleh model klasifikasikan apakah konsumen akan memutuskan untuk membeli atau tidak dan berapa nilai CTR nya.
Planning Dashboard
Planning Dashboard


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].

6 Business Impact

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.

7 Data Preparation

7.1 Importing Libraries

library(dplyr)
library(ggplot2)
library(GGally)
library(RColorBrewer)
library(hrbrthemes)

7.2 Importing Dataset

dm <- read.csv("digital_marketing_campaign_dataset.csv")
rmarkdown::paged_table(dm)

7.3 Data Wrangling

Duplicates & Missing Values

sum(duplicated(dm))
## [1] 0
colSums(is.na(x = dm))
##          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…
summary(dm_clean)
##       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

8 Exploratory Data Analysis

8.1 Proporsi kelas target

dm %>% 
  ggplot(aes(x = Conversion)) +
  geom_bar(fill = "darkgreen") +
  theme_ipsum()

Perbandingan antara data yang bernilai 0 dan 1 kurang seimbang, sehingga perlu dilakukan proses upsampling atau downsampling pada data training.

8.2 Distribusi demografi

8.2.1 Distribusi demografi berdasarkan usia

dm_clean %>% 
  ggplot(aes(x = Age)) +
  geom_histogram(fill = "maroon", bins = 12) +
  theme_ipsum()

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.

8.2.2 Distribusi demografi berdasarkan generasi

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)
head(dm_clean)
dm_clean %>% 
  ggplot(aes(x = Age_cat)) +
  geom_bar(fill = "maroon") +
  theme_ipsum()

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_1
library(reshape2)
meltGen_1 <- melt(Gen_1, id=c("Age_cat"))
head(meltGen_1)
ggplot(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.

8.2.3 Distribusi demografi berdasarkan gender

dm_clean %>% 
  ggplot(aes(x = Gender)) +
  geom_bar(fill = "maroon") +
  theme_ipsum()

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_2
library(reshape2)
meltGen_2 <- melt(Gen_2, id=c("Gender"))
head(meltGen_2)
ggplot(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.

8.2.4 Distribusi demografi berdasarkan income

dm_clean %>% 
  ggplot(aes(x = Income)) +
  geom_histogram(fill = "maroon", bins = 18) +
  theme_ipsum()

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)
dm_clean %>% 
  ggplot(aes(x = Income_cat)) +
  geom_bar(fill = "maroon") +
  theme_ipsum()

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_3
library(reshape2)
meltGen_3 <- melt(Gen_3, id=c("Income_cat"))
head(meltGen_3)
ggplot(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.

8.3 Campaign channel yang paling banyak digunakan

dm_clean %>% 
  ggplot(aes(x = CampaignChannel)) +
  geom_bar(fill = "maroon") +
  theme_ipsum()

Campaign channel yang paling banyak digunakan adalah referral, namun jumlah nya tidak signifikan jika dibandingkan dengan campaign channel lainnya.

8.4 Tipe campaign yang paling banyak digunakan

dm_clean %>% 
  ggplot(aes(x = CampaignType)) +
  geom_bar(fill = "maroon") +
  theme_ipsum()

Tipe campaign yang paling banyak digunakan adalah conversion, namun jumlahnya seimbang dengan tipe campaign lainnya.

8.5 Sebaran customer engagement variables berdasarkan generasi, gender, dan income

8.5.1 Sebaran customer engagement variables berdasarkan generasi

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_CE
ggplot(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.

8.5.2 Sebaran customer engagement variables berdasarkan gender

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_CE2
ggplot(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.

8.5.3 Sebaran customer engagement variables berdasarkan income

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_CE3
ggplot(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.

9 Cross Validation

9.1 Cross Validation Model Klasifikasi

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
prop.table(table(dm_trainc$Conversion))
## 
##         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.

prop.table(table(dm_train_up$Conversion))
## 
##   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:

  • Standarisasi z-score: Rata-rata setiap fitur menjadi 0 dan simpangan baku menjadi 1.
  • Normalisasi: Nilai setiap fitur berada di antara 0 dan 1.
  • Penskalaan Min-Maks: Nilai minimum setiap fitur menjadi 0 dan nilai maksimum menjadi 1.

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_xs

Kemudian pada data train digabungkan kolom prediktor hasil scaling dan kolom target yang tidak di scaling.

#Data hasil scaling
#data train
ctrain_s <- cbind(data.frame(ctrain_xs), ctrain_upcat)

#data test
ctest_s <- cbind(data.frame(ctest_xs), ctest_cat)

9.2 Cross Validation Model Regresi

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_xs

Kemudian 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]" )

10 Pembangunan Model

10.1 Model Klasifikasi (Conversion)

10.1.1 1. Logistic Regression Classifier

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_log

10.1.2 2. Random Forest Classifier

Model

#model_forestclass <- train(Conversion ~ .,
#                    data = ctrain_s,
#                    method = "rf")
#saveRDS(model_forestclass, "model_forestclass.RDS")
c_model_forest <- readRDS("model_forestclass.RDS")
c_model_forest
## 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_forest

10.1.3 3. Naive Bayes Classifier

Model

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_bayes

10.1.4 4. XGBoost Classifier

Model

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_xgb
summary_class <- rbind(eval_c_log, eval_c_forest, eval_c_bayes, eval_c_xgb)
summary_class

10.2 Model Regression (CTR)

10.2.1 1. Linear Regression

Model

model_linear <- lm(ClickThroughRate ~ ., data = rtrain_s)
summary(model_linear)
## 
## 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_linear

10.2.2 2. Random Forest Regressor

Model

library(randomForest)

#set.seed(100)
#model_forestreg <- randomForest(ClickThroughRate ~ ., 
#                                data=rtrain_s)
#saveRDS(model_forestreg, "model_forestreg.RDS")
rmodel_rf1 <- readRDS("model_forestreg.RDS")
rmodel_rf1
## 
## 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_rf1

10.2.3 3. LightGBM Regressor

Model

#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_lgbm

10.2.4 4. XGBoost Regressor

Model

#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_xgb

10.3 Evaluasi Model

Summary 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.


Confusion Matrix
Confusion Matrix


summary_class <- rbind(eval_c_log, eval_c_forest, eval_c_bayes, eval_c_xgb)
summary_class

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.

summary_regression <- rbind(eval_r_linear, eval_r_rf1, eval_r_lgbm, eval_r_xgb)
summary_regression
range(rtrain_s$ClickThroughRate)
## [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.

10.4 Tuning Model

10.4.1 Model Klasifikasi

10.4.1.1 1. Random Forest Classifier

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

print(bestmtry)
##       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")
c_rf_tune <- readRDS("model_forestclass_tune.RDS")
c_rf_tune
## 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

10.4.1.2 2. XGBoost Classifier

#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])
#convert factor to numeric 
labels <- as.numeric(labels)-1
ts_label <- as.numeric(ts_label)-1
#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
best_iter <- xgbcv$best_iteration
best_iter
## [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_xgbtune
summary_classtune <- rbind(eval_c_log, eval_c_forest, eval_c_bayes, eval_c_xgb, eval_c_foresttune, eval_c_xgbtune)
summary_classtune

10.4.2 Model Regresi

10.4.2.1 1. LightGBM Regressor

# 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_lgbmtune

10.4.2.2 2. XGBoost Regressor

Model 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
# 3. Make workflow 
xgb_wflow <- 
  workflow() %>% 
  add_model(xgbr_tune) %>% 
  add_recipe(rcp)
xgb_wflow %>% extract_parameter_dials("trees")
## # Trees (quantitative)
## Range: [1, 2000]
# 4. Create a tibble with the specific range for trees
trees_values <- tibble(trees = 5:50)
# 5. Define specific metrics
mae_res <- metric_set(mae)
# 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
)
show_best <- show_best(tuning_results, n = 1)
show_best
#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_xgbtune
summary_regressiontune <- rbind(eval_r_linear, eval_r_rf1, eval_r_lgbm, eval_r_xgb, eval_r_lgbmtune ,eval_r_xgbtune)
summary_regressiontune

10.5 Model Interpretation using SHAP

Model 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

#Merubah tipe data train menjadi matrix
X1 <- data.matrix(new_tr, labels)
head(X1)
##          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.

11 Dashboarding Preparation

11.1 Plot Distribusi Demografi

head(dm_clean)
library(glue)
library(plotly)
library(RColorBrewer)
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_gen
kategori_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_gender
kategori_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_income
demo <-  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')

11.2 Plot Sebaran Customer Engagement

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')

11.3 Plot Perbandingan Performa Model

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')