Midterm
2024-10-10
I: Libraries
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(data.table)##
## Attaching package: 'data.table'## The following objects are masked from 'package:dplyr':
##
## between, first, lastlibrary(ggplot2)
library(reshape2)##
## Attaching package: 'reshape2'## The following objects are masked from 'package:data.table':
##
## dcast, meltlibrary(gridExtra)##
## Attaching package: 'gridExtra'## The following object is masked from 'package:dplyr':
##
## combinelibrary(psych)##
## Attaching package: 'psych'## The following objects are masked from 'package:ggplot2':
##
## %+%, alphalibrary(caret)## Loading required package: latticelibrary(lattice)
library(DMwR2)## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoolibrary(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ lubridate 1.9.3 ✔ tibble 3.2.1
## ✔ purrr 1.0.2 ✔ tidyr 1.3.1
## ✔ readr 2.1.5## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ psych::%+%() masks ggplot2::%+%()
## ✖ psych::alpha() masks ggplot2::alpha()
## ✖ data.table::between() masks dplyr::between()
## ✖ gridExtra::combine() masks dplyr::combine()
## ✖ dplyr::filter() masks stats::filter()
## ✖ data.table::first() masks dplyr::first()
## ✖ lubridate::hour() masks data.table::hour()
## ✖ lubridate::isoweek() masks data.table::isoweek()
## ✖ dplyr::lag() masks stats::lag()
## ✖ data.table::last() masks dplyr::last()
## ✖ purrr::lift() masks caret::lift()
## ✖ lubridate::mday() masks data.table::mday()
## ✖ lubridate::minute() masks data.table::minute()
## ✖ lubridate::month() masks data.table::month()
## ✖ lubridate::quarter() masks data.table::quarter()
## ✖ lubridate::second() masks data.table::second()
## ✖ purrr::transpose() masks data.table::transpose()
## ✖ lubridate::wday() masks data.table::wday()
## ✖ lubridate::week() masks data.table::week()
## ✖ lubridate::yday() masks data.table::yday()
## ✖ lubridate::year() masks data.table::year()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorsII: Source
C. Sakar and Y. Kastro. “Online Shoppers Purchasing Intention Dataset,” UCI Machine Learning Repository, 2018. [Online]. Available: https://doi.org/10.24432/C5F88Q.
III: Get the data
data = read.csv("C:\\Users\\ADMIN\\OneDrive\\junior(24-25)\\Predictive Data\\data\\online_shoppers_intention.csv")
head(data)## Administrative Administrative_Duration Informational Informational_Duration
## 1 0 0 0 0
## 2 0 0 0 0
## 3 0 0 0 0
## 4 0 0 0 0
## 5 0 0 0 0
## 6 0 0 0 0
## ProductRelated ProductRelated_Duration BounceRates ExitRates PageValues
## 1 1 0.000000 0.20000000 0.2000000 0
## 2 2 64.000000 0.00000000 0.1000000 0
## 3 1 0.000000 0.20000000 0.2000000 0
## 4 2 2.666667 0.05000000 0.1400000 0
## 5 10 627.500000 0.02000000 0.0500000 0
## 6 19 154.216667 0.01578947 0.0245614 0
## SpecialDay Month OperatingSystems Browser Region TrafficType
## 1 0 Feb 1 1 1 1
## 2 0 Feb 2 2 1 2
## 3 0 Feb 4 1 9 3
## 4 0 Feb 3 2 2 4
## 5 0 Feb 3 3 1 4
## 6 0 Feb 2 2 1 3
## VisitorType Weekend Revenue
## 1 Returning_Visitor FALSE FALSE
## 2 Returning_Visitor FALSE FALSE
## 3 Returning_Visitor FALSE FALSE
## 4 Returning_Visitor FALSE FALSE
## 5 Returning_Visitor TRUE FALSE
## 6 Returning_Visitor FALSE FALSEIV: Exploratory data analysis
#library(data.table)
df <- copy(data)
summary(df)## Administrative Administrative_Duration Informational
## Min. : 0.000 Min. : 0.00 Min. : 0.0000
## 1st Qu.: 0.000 1st Qu.: 0.00 1st Qu.: 0.0000
## Median : 1.000 Median : 7.50 Median : 0.0000
## Mean : 2.315 Mean : 80.82 Mean : 0.5036
## 3rd Qu.: 4.000 3rd Qu.: 93.26 3rd Qu.: 0.0000
## Max. :27.000 Max. :3398.75 Max. :24.0000
## Informational_Duration ProductRelated ProductRelated_Duration
## Min. : 0.00 Min. : 0.00 Min. : 0.0
## 1st Qu.: 0.00 1st Qu.: 7.00 1st Qu.: 184.1
## Median : 0.00 Median : 18.00 Median : 598.9
## Mean : 34.47 Mean : 31.73 Mean : 1194.8
## 3rd Qu.: 0.00 3rd Qu.: 38.00 3rd Qu.: 1464.2
## Max. :2549.38 Max. :705.00 Max. :63973.5
## BounceRates ExitRates PageValues SpecialDay
## Min. :0.000000 Min. :0.00000 Min. : 0.000 Min. :0.00000
## 1st Qu.:0.000000 1st Qu.:0.01429 1st Qu.: 0.000 1st Qu.:0.00000
## Median :0.003112 Median :0.02516 Median : 0.000 Median :0.00000
## Mean :0.022191 Mean :0.04307 Mean : 5.889 Mean :0.06143
## 3rd Qu.:0.016813 3rd Qu.:0.05000 3rd Qu.: 0.000 3rd Qu.:0.00000
## Max. :0.200000 Max. :0.20000 Max. :361.764 Max. :1.00000
## Month OperatingSystems Browser Region
## Length:12330 Min. :1.000 Min. : 1.000 Min. :1.000
## Class :character 1st Qu.:2.000 1st Qu.: 2.000 1st Qu.:1.000
## Mode :character Median :2.000 Median : 2.000 Median :3.000
## Mean :2.124 Mean : 2.357 Mean :3.147
## 3rd Qu.:3.000 3rd Qu.: 2.000 3rd Qu.:4.000
## Max. :8.000 Max. :13.000 Max. :9.000
## TrafficType VisitorType Weekend Revenue
## Min. : 1.00 Length:12330 Mode :logical Mode :logical
## 1st Qu.: 2.00 Class :character FALSE:9462 FALSE:10422
## Median : 2.00 Mode :character TRUE :2868 TRUE :1908
## Mean : 4.07
## 3rd Qu.: 4.00
## Max. :20.00=> Tập dữ liệu bao gồm 18 cột (15 số, 2 đối tượng và 2 boolean) và 12330 hàng, trong đó không có dữ liệu trống.
Missing values check
# Count total missing values in the entire dataframe
total_missing_values <- sum(is.na(df))
# Print the result
print(total_missing_values)## [1] 0=> Bộ dữ liệu có chất lượng khá tốt, không có giá trị NULL
library(ggplot2)
# Kiểm tra sự mất cân bằng
balance_check <- df %>%
group_by(Revenue) %>%
summarise(Count = n()) %>%
mutate(Percentage = Count / sum(Count) * 100)
print(balance_check)## # A tibble: 2 × 3
## Revenue Count Percentage
## <lgl> <int> <dbl>
## 1 FALSE 10422 84.5
## 2 TRUE 1908 15.5# Vẽ biểu đồ phân phối
ggplot(balance_check, aes(x = Revenue, y = Count, fill = Revenue)) +
geom_bar(stat = "identity") +
labs(title = "Distribution of Revenue", x = "Revenue", y = "Count") +
theme_minimal()
#library(dplyr)
# Chuyển đổi kiểu dữ liệu của các cột
df <- df %>%
mutate(
OperatingSystems = as.character(OperatingSystems),
Browser = as.character(Browser),
Region = as.character(Region),
TrafficType = as.character(TrafficType)
)
# Xác định các cột số liệu, cột phân loại và cột thời gian
numericals <- c('Administrative', 'Administrative_Duration', 'Informational', 'Informational_Duration', 'ProductRelated',
'ProductRelated_Duration', 'BounceRates', 'ExitRates', 'PageValues', 'SpecialDay', 'Revenue')
categoricals <- c('OperatingSystems', 'Browser', 'Region', 'TrafficType', 'VisitorType', 'Weekend', 'Revenue')
timestamps <- c('Month')
# Hiển thị dataframe sau khi chuyển đổi kiểu dữ liệu
str(df)## 'data.frame': 12330 obs. of 18 variables:
## $ Administrative : int 0 0 0 0 0 0 0 1 0 0 ...
## $ Administrative_Duration: num 0 0 0 0 0 0 0 0 0 0 ...
## $ Informational : int 0 0 0 0 0 0 0 0 0 0 ...
## $ Informational_Duration : num 0 0 0 0 0 0 0 0 0 0 ...
## $ ProductRelated : int 1 2 1 2 10 19 1 0 2 3 ...
## $ ProductRelated_Duration: num 0 64 0 2.67 627.5 ...
## $ BounceRates : num 0.2 0 0.2 0.05 0.02 ...
## $ ExitRates : num 0.2 0.1 0.2 0.14 0.05 ...
## $ PageValues : num 0 0 0 0 0 0 0 0 0 0 ...
## $ SpecialDay : num 0 0 0 0 0 0 0.4 0 0.8 0.4 ...
## $ Month : chr "Feb" "Feb" "Feb" "Feb" ...
## $ OperatingSystems : chr "1" "2" "4" "3" ...
## $ Browser : chr "1" "2" "1" "2" ...
## $ Region : chr "1" "1" "9" "2" ...
## $ TrafficType : chr "1" "2" "3" "4" ...
## $ VisitorType : chr "Returning_Visitor" "Returning_Visitor" "Returning_Visitor" "Returning_Visitor" ...
## $ Weekend : logi FALSE FALSE FALSE FALSE TRUE FALSE ...
## $ Revenue : logi FALSE FALSE FALSE FALSE FALSE FALSE ...Statistics Summary
# Select numerical columns and get descriptive statistics
numerical_summary <- df %>%
select(all_of(numericals)) %>%
summary()
# Print the result
print(numerical_summary)## Administrative Administrative_Duration Informational
## Min. : 0.000 Min. : 0.00 Min. : 0.0000
## 1st Qu.: 0.000 1st Qu.: 0.00 1st Qu.: 0.0000
## Median : 1.000 Median : 7.50 Median : 0.0000
## Mean : 2.315 Mean : 80.82 Mean : 0.5036
## 3rd Qu.: 4.000 3rd Qu.: 93.26 3rd Qu.: 0.0000
## Max. :27.000 Max. :3398.75 Max. :24.0000
## Informational_Duration ProductRelated ProductRelated_Duration
## Min. : 0.00 Min. : 0.00 Min. : 0.0
## 1st Qu.: 0.00 1st Qu.: 7.00 1st Qu.: 184.1
## Median : 0.00 Median : 18.00 Median : 598.9
## Mean : 34.47 Mean : 31.73 Mean : 1194.8
## 3rd Qu.: 0.00 3rd Qu.: 38.00 3rd Qu.: 1464.2
## Max. :2549.38 Max. :705.00 Max. :63973.5
## BounceRates ExitRates PageValues SpecialDay
## Min. :0.000000 Min. :0.00000 Min. : 0.000 Min. :0.00000
## 1st Qu.:0.000000 1st Qu.:0.01429 1st Qu.: 0.000 1st Qu.:0.00000
## Median :0.003112 Median :0.02516 Median : 0.000 Median :0.00000
## Mean :0.022191 Mean :0.04307 Mean : 5.889 Mean :0.06143
## 3rd Qu.:0.016813 3rd Qu.:0.05000 3rd Qu.: 0.000 3rd Qu.:0.00000
## Max. :0.200000 Max. :0.20000 Max. :361.764 Max. :1.00000
## Revenue
## Mode :logical
## FALSE:10422
## TRUE :1908
##
##
## - Độ lệch: Tất cả các tính năng (cột) đều có độ lệch dương.
- Có một số giá trị tóm tắt cần được đánh dấu: Q1, Q2, Q3 cho các giá trị Informational, Informational_Duration và SpecialDay bằng 0.
- Giá trị tối đa cho PageValues là rất lớn, biểu thị một giá trị ngoại lệ.
# Select categorical columns and get descriptive statistics
categorical_summary <- df %>%
select(all_of(categoricals)) %>%
summary()
# Print the result
print(categorical_summary)## OperatingSystems Browser Region TrafficType
## Length:12330 Length:12330 Length:12330 Length:12330
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
## VisitorType Weekend Revenue
## Length:12330 Mode :logical Mode :logical
## Class :character FALSE:9462 FALSE:10422
## Mode :character TRUE :2868 TRUE :1908# Vòng lặp qua từng cột thời gian và in ra số lượng giá trị
for (col in timestamps) {
cat('Số lượng giá trị của cột', col, ':\n')
print(table(df[[col]]))
cat('\n')
}## Số lượng giá trị của cột Month :
##
## Aug Dec Feb Jul June Mar May Nov Oct Sep
## 433 1727 184 432 288 1907 3364 2998 549 448Các khách hàng có lượt ghé nhiều nhất là các khách hàng quay trở lại, vào các ngày trong tuần, không tạo giao dịch và vào tháng 5
Phân phối đặc trưng cho từng giá trị doanh thu
A. Các đặc trưng dạng số
Boxplot:(hay còn gọi là biểu đồ hộp) là một công cụ trực quan dùng để mô tả sự phân bố của một tập dữ liệu. Nó hiển thị các giá trị thống kê quan trọng như:median(trung vị), quartilers (tứ phân vị), outliers (điểm ngoại lai),..
#library(gridExtra)
# Create boxplots for each numerical feature
plots <- list()
for (i in 1:length(numericals)) {
p <- ggplot(df, aes_string(x = 'Revenue', y = numericals[i])) +
geom_boxplot() +
ggtitle(paste(numericals[i]))
plots[[i]] <- p
}## Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
## ℹ Please use tidy evaluation idioms with `aes()`.
## ℹ See also `vignette("ggplot2-in-packages")` for more information.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.# Arrange plots in a grid
grid.arrange(grobs = plots, ncol = 5)
=> Có khá nhiều ngoại lệ => Phân phối của tỷ lệ ExitRates và BounceRates của khách hàng không mua hàng có xu hướng cao hơn các khách hàng có giao dịch mua bán
Biểu đồ phân phối mật độ xác suất
# Create density plots for each numerical feature
plots <- list()
for (i in 1:length(numericals)) {
p <- ggplot(df, aes_string(x = numericals[i], color = 'Revenue')) +
geom_density() +
ggtitle(paste(numericals[i])) +
theme_minimal()
plots[[i]] <- p
}
# Arrange plots in a grid
grid.arrange(grobs = plots, ncol = 5)
=> Nhìn chung, mỗi đặc điểm đều có sự phân bố sai lệch dương. Khách hàng có xu hướng ít truy cập các trang Quản trị và Thông tin
Correlation Heatmap (numerical)
#library(ggplot2)
#library(reshape2)
# Chuyển đổi các cột không phải là số sang số (nếu cần)
df<- df %>%
mutate_if(is.character, as.factor) %>%
mutate_if(is.factor, as.numeric)
# Calculate the correlation matrix
cor_matrix <- round(cor(df), 2)
# Melt the correlation matrix
melted_cor_matrix <- melt(cor_matrix)
# Create the heatmap
ggplot(data = melted_cor_matrix, aes(x = Var1, y = Var2, fill = value)) +
geom_tile() +
geom_text(aes(label = value), size = 2) +
scale_fill_gradient2(low = "blue", high = "red", mid = "white", midpoint = 0, limit = c(-1, 1), space = "Lab", name="Correlation") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1),
axis.title.x = element_blank(), axis.title.y = element_blank(), panel.background = element_blank()) +
ggtitle("Data Correlation")
Giá trị tương quan tính năng khác với biến mục tiêu (Revenue): - Highest positive: PageValues (0,49) - Most negative: ExitRates (-0,21) - Các đặc trưng khác nằm trong khoảng từ 0,03-0,16 Đặc trưng có giá trị tương quan > 0,8: - ExitRates và BounceRates (0,91) - ProductRelated và ProductRelatedDuration (0,86)
B. Các đặc trưng phân loại
# số lượng người dùng đã mua hàng không vì bất kỳ đặc trưng nào
# Define boolean columns
others_bool <- c('VisitorType', 'Weekend')
# Create count plots for each boolean feature
plots <- list()
for (i in 1:length(others_bool)) {
p <- ggplot(df, aes_string(x = others_bool[i], fill = 'Revenue')) +
geom_bar(position = 'dodge') +
ggtitle(paste(others_bool[i])) +
theme_minimal()
plots[[i]] <- p
}
# Arrange plots in a grid
grid.arrange(grobs = plots, ncol = 2)
# Define other features
others <- c('Month', 'OperatingSystems', 'Browser', 'Region')
# Create count plots for each feature
plots <- list()
for (i in 1:length(others)) {
p <- ggplot(df, aes_string(x = others[i], fill = 'Revenue')) +
geom_bar(position = 'dodge') +
ggtitle(paste(others[i])) +
theme_minimal()
plots[[i]] <- p
}
# Arrange plots in a grid
grid.arrange(grobs = plots, ncol = 2)
Phần lớn khách hàng mua hàng là: - Visitor Type: Returning Visitor - Weekends: False - Month: Nov - Operating Systems: 2 - Browsers: 2 - Regions: 1
#tỷ lệ các giá trị doanh thu khác
# Define the features
features <- c('VisitorType', 'Weekend')
# Create percentage plots for each feature
plots <- list()
for (feature in features) {
df_percent <- df %>%
group_by(!!sym(feature), Revenue) %>%
summarise(count = n()) %>%
mutate(percent = count / sum(count) * 100)
p <- ggplot(df_percent, aes_string(x = feature, y = 'percent', fill = 'Revenue')) +
geom_bar(stat = 'identity', position = 'dodge') +
ggtitle(paste('Percentage of Revenue by', feature)) +
theme_minimal()
plots[[feature]] <- p
}## `summarise()` has grouped output by 'VisitorType'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'Weekend'. You can override using the
## `.groups` argument.# Display the plots
library(gridExtra)
do.call(grid.arrange, c(plots, ncol = 2))
Tỷ lệ người dùng đã mua hàng cho từng tính năng (ước lượng): Loại khách
truy cập: - Mới 23%, - Quay lại 19%, - Khác 17% Cuối tuần: Sai 15%, Đúng
16%
=> Dựa vào biểu đồ phân bố số lượng và tỷ lệ phần trăm của tỷ lệ thực hiện mua hàng: Số lượng Khách quay lại khá lớn nhưng chỉ có 19% thực hiện mua hàng. Nhiều người dùng truy cập trang vào các ngày trong tuần nhưng khá nhiều người không mua hàng.
Tính tỷ lệ doanh thu mỗi tháng
# Calculate percentage for each revenue value by month
df_percent <- df %>%
group_by(Month, Revenue) %>%
summarise(count = n()) %>%
mutate(percent = count / sum(count) * 100)## `summarise()` has grouped output by 'Month'. You can override using the
## `.groups` argument.# Create the bar plot
ggplot(df_percent, aes(x = Month, y = percent, fill = Revenue)) +
geom_bar(stat = 'identity', position = 'dodge') +
ggtitle('Percentage of Revenue by Month') +
theme_minimal() +
labs(x = 'Month', y = 'Percentage') +
scale_fill_manual(values = c('TRUE' = 'blue', 'FALSE' = 'red')) +
scale_x_discrete(limits = month.name)
library(ggplot2)
# Tạo biểu đồ
ggplot(df, aes(x = Month, fill = VisitorType)) +
geom_bar(position = "dodge") +
facet_wrap(~ Revenue) +
theme_minimal() +
theme(
plot.title = element_text(size = 12, face = "bold"),
axis.text.x = element_text(angle = 45, hjust = 1)
) +
labs(
title = "Distribution of Users by Month and Visitor Type",
x = "Month",
y = "Count",
fill = "Visitor Type"
) +
scale_x_discrete(limits = month.name) + scale_fill_manual(values = c('TRUE' = 'blue', 'FALSE' = 'red'))## Warning: The following aesthetics were dropped during statistical transformation: fill.
## ℹ This can happen when ggplot fails to infer the correct grouping structure in
## the data.
## ℹ Did you forget to specify a `group` aesthetic or to convert a numerical
## variable into a factor?
## The following aesthetics were dropped during statistical transformation: fill.
## ℹ This can happen when ggplot fails to infer the correct grouping structure in
## the data.
## ℹ Did you forget to specify a `group` aesthetic or to convert a numerical
## variable into a factor?## Warning: No shared levels found between `names(values)` of the manual scale and the
## data's fill values.
V: Data pre-processing
1. Handling duplicated data
df_removed <- df %>% distinct()
duplicate_drop_percentage <- round(((nrow(df) - nrow(df_removed))/nrow(df)) * 100, 2)
cat("Duplicate data drop percentage:", duplicate_drop_percentage, "%\n")## Duplicate data drop percentage: 1.01 %2. Handling outliers
IQR_outliers <- function(x) {
q1 <- quantile(x, 0.25)
q3 <- quantile(x, 0.75)
bb <- q1 - 1.5 * (q3 - q1)
ba <- q3 + 1.5 * (q3 - q1)
outlier_indices <- which(x < bb | x > ba)
outlier_values <- x[outlier_indices]
return(length(outlier_indices))
}#IQR method
for (i in numericals) {
cat("Number of IQR outliers", i, ":", IQR_outliers(df[[i]]), "\n")
}## Number of IQR outliers Administrative : 404
## Number of IQR outliers Administrative_Duration : 1172
## Number of IQR outliers Informational : 2631
## Number of IQR outliers Informational_Duration : 2405
## Number of IQR outliers ProductRelated : 987
## Number of IQR outliers ProductRelated_Duration : 961
## Number of IQR outliers BounceRates : 1551
## Number of IQR outliers ExitRates : 1099
## Number of IQR outliers PageValues : 2730
## Number of IQR outliers SpecialDay : 1251
## Number of IQR outliers Revenue : 1908Dữ liệu có khá nhiều giá trị 0, không thể nhìn thấy sự phân bổ của từng đặc trưng. Do số lượng lớn dữ liệu có giá trị bằng 0 nên không thể xử lý các giá trị ngoại lệ bằng cách sử dụng Log transformation. - Nếu loại bỏ các ngoại lệ thì tỷ lệ các ngoại lệ bị loại bỏ (17,9% > 5%) là rất lớn. - Không có giá trị ngoại lệ nào được thực hiện nên số lượng hàng vẫn là 12205. - Điều này cũng được hỗ trợ bởi thông tin trong tập dữ liệu thu được thông qua Google Analytics. Ở giá trị tối đa, giá trị này vẫn có ý nghĩa. Ví dụ: Informational_Duration có thể xảy ra khi người dùng/khách truy cập mở và sau đó cho phép trang vẫn mở trên thiết bị. Nhưng tất nhiên, không thể biết chắc chắn trạng thái của các giá trị ngoại lệ có trong dữ liệu. - Sự tồn tại của các giá trị ngoại lệ trong dữ liệu cần được lưu ý khi lập mô hình.
3. Encoder data
Chuyển dữ liệu
Chuyển đổi biến số (False: 0, True: 1)
# label encoding for Revenue, Weekend
df_removed$Revenue <- ifelse(df_removed$Revenue == TRUE, 1, 0)
df_removed$Weekend <- ifelse(df_removed$Weekend == TRUE, 1, 0)
str(df_removed)## 'data.frame': 12205 obs. of 18 variables:
## $ Administrative : int 0 0 0 0 0 0 0 1 0 0 ...
## $ Administrative_Duration: num 0 0 0 0 0 0 0 0 0 0 ...
## $ Informational : int 0 0 0 0 0 0 0 0 0 0 ...
## $ Informational_Duration : num 0 0 0 0 0 0 0 0 0 0 ...
## $ ProductRelated : int 1 2 1 2 10 19 1 0 2 3 ...
## $ ProductRelated_Duration: num 0 64 0 2.67 627.5 ...
## $ BounceRates : num 0.2 0 0.2 0.05 0.02 ...
## $ ExitRates : num 0.2 0.1 0.2 0.14 0.05 ...
## $ PageValues : num 0 0 0 0 0 0 0 0 0 0 ...
## $ SpecialDay : num 0 0 0 0 0 0 0.4 0 0.8 0.4 ...
## $ Month : num 3 3 3 3 3 3 3 3 3 3 ...
## $ OperatingSystems : num 1 2 4 3 3 2 2 1 2 2 ...
## $ Browser : num 1 6 1 6 7 6 8 6 6 8 ...
## $ Region : num 1 1 9 2 1 1 3 1 2 1 ...
## $ TrafficType : num 1 12 14 15 15 14 14 16 14 12 ...
## $ VisitorType : num 3 3 3 3 3 3 3 3 3 3 ...
## $ Weekend : num 0 0 0 0 1 0 0 1 0 0 ...
## $ Revenue : num 0 0 0 0 0 0 0 0 0 0 ...# label encoding for Month
df_removed$Month <- as.numeric(factor(df_removed$Month))
str(df_removed)## 'data.frame': 12205 obs. of 18 variables:
## $ Administrative : int 0 0 0 0 0 0 0 1 0 0 ...
## $ Administrative_Duration: num 0 0 0 0 0 0 0 0 0 0 ...
## $ Informational : int 0 0 0 0 0 0 0 0 0 0 ...
## $ Informational_Duration : num 0 0 0 0 0 0 0 0 0 0 ...
## $ ProductRelated : int 1 2 1 2 10 19 1 0 2 3 ...
## $ ProductRelated_Duration: num 0 64 0 2.67 627.5 ...
## $ BounceRates : num 0.2 0 0.2 0.05 0.02 ...
## $ ExitRates : num 0.2 0.1 0.2 0.14 0.05 ...
## $ PageValues : num 0 0 0 0 0 0 0 0 0 0 ...
## $ SpecialDay : num 0 0 0 0 0 0 0.4 0 0.8 0.4 ...
## $ Month : num 3 3 3 3 3 3 3 3 3 3 ...
## $ OperatingSystems : num 1 2 4 3 3 2 2 1 2 2 ...
## $ Browser : num 1 6 1 6 7 6 8 6 6 8 ...
## $ Region : num 1 1 9 2 1 1 3 1 2 1 ...
## $ TrafficType : num 1 12 14 15 15 14 14 16 14 12 ...
## $ VisitorType : num 3 3 3 3 3 3 3 3 3 3 ...
## $ Weekend : num 0 0 0 0 1 0 0 1 0 0 ...
## $ Revenue : num 0 0 0 0 0 0 0 0 0 0 ...df_removed$VisitorType <- as.factor(df_removed$VisitorType)
# Kiểm tra kết quả
summary(df_removed$VisitorType)## 1 2 3
## 1693 81 10431One Hot Encoding Feature Categorical
# Định nghĩa hàm mã hóa one-hot cho cột VisitorType
dummy <- dummyVars(" ~ VisitorType", data = df_removed)
# Áp dụng mã hóa one-hot và chuyển đổi kết quả thành khung dữ liệu
onehot <- data.frame(predict(dummy, newdata = df_removed))
# Đổi tên các cột one-hot encoding
colnames(onehot) <- c("VT_NewVisitor", "VT_OtherVisitor", "VT_ReturningVisitor")
# Kết hợp khung dữ liệu gốc với các cột mã hóa one-hot
df_removed <- cbind(df_removed, onehot)
# Xóa cột VisitorType gốc
df_removed <- df_removed %>% select(-VisitorType)
# Tạo bộ dữ liệu mới tên df_cleaned
df_cleaned <- df_removed
# Hiển thị thông tin về bộ dữ liệu mới
str(df_cleaned)## 'data.frame': 12205 obs. of 20 variables:
## $ Administrative : int 0 0 0 0 0 0 0 1 0 0 ...
## $ Administrative_Duration: num 0 0 0 0 0 0 0 0 0 0 ...
## $ Informational : int 0 0 0 0 0 0 0 0 0 0 ...
## $ Informational_Duration : num 0 0 0 0 0 0 0 0 0 0 ...
## $ ProductRelated : int 1 2 1 2 10 19 1 0 2 3 ...
## $ ProductRelated_Duration: num 0 64 0 2.67 627.5 ...
## $ BounceRates : num 0.2 0 0.2 0.05 0.02 ...
## $ ExitRates : num 0.2 0.1 0.2 0.14 0.05 ...
## $ PageValues : num 0 0 0 0 0 0 0 0 0 0 ...
## $ SpecialDay : num 0 0 0 0 0 0 0.4 0 0.8 0.4 ...
## $ Month : num 3 3 3 3 3 3 3 3 3 3 ...
## $ OperatingSystems : num 1 2 4 3 3 2 2 1 2 2 ...
## $ Browser : num 1 6 1 6 7 6 8 6 6 8 ...
## $ Region : num 1 1 9 2 1 1 3 1 2 1 ...
## $ TrafficType : num 1 12 14 15 15 14 14 16 14 12 ...
## $ Weekend : num 0 0 0 0 1 0 0 1 0 0 ...
## $ Revenue : num 0 0 0 0 0 0 0 0 0 0 ...
## $ VT_NewVisitor : num 0 0 0 0 0 0 0 0 0 0 ...
## $ VT_OtherVisitor : num 0 0 0 0 0 0 0 0 0 0 ...
## $ VT_ReturningVisitor : num 1 1 1 1 1 1 1 1 1 1 ...Featuring Engineering
Numeric Correlation
# Chuyển đổi các cột không phải là số sang số (nếu cần)
df_cleaned <- df_cleaned %>%
mutate_if(is.character, as.factor) %>%
mutate_if(is.factor, as.numeric)
# Kiểm tra lại kiểu dữ liệu sau khi chuyển đổi
str(df_cleaned)## 'data.frame': 12205 obs. of 20 variables:
## $ Administrative : int 0 0 0 0 0 0 0 1 0 0 ...
## $ Administrative_Duration: num 0 0 0 0 0 0 0 0 0 0 ...
## $ Informational : int 0 0 0 0 0 0 0 0 0 0 ...
## $ Informational_Duration : num 0 0 0 0 0 0 0 0 0 0 ...
## $ ProductRelated : int 1 2 1 2 10 19 1 0 2 3 ...
## $ ProductRelated_Duration: num 0 64 0 2.67 627.5 ...
## $ BounceRates : num 0.2 0 0.2 0.05 0.02 ...
## $ ExitRates : num 0.2 0.1 0.2 0.14 0.05 ...
## $ PageValues : num 0 0 0 0 0 0 0 0 0 0 ...
## $ SpecialDay : num 0 0 0 0 0 0 0.4 0 0.8 0.4 ...
## $ Month : num 3 3 3 3 3 3 3 3 3 3 ...
## $ OperatingSystems : num 1 2 4 3 3 2 2 1 2 2 ...
## $ Browser : num 1 6 1 6 7 6 8 6 6 8 ...
## $ Region : num 1 1 9 2 1 1 3 1 2 1 ...
## $ TrafficType : num 1 12 14 15 15 14 14 16 14 12 ...
## $ Weekend : num 0 0 0 0 1 0 0 1 0 0 ...
## $ Revenue : num 0 0 0 0 0 0 0 0 0 0 ...
## $ VT_NewVisitor : num 0 0 0 0 0 0 0 0 0 0 ...
## $ VT_OtherVisitor : num 0 0 0 0 0 0 0 0 0 0 ...
## $ VT_ReturningVisitor : num 1 1 1 1 1 1 1 1 1 1 ...library(reshape2)
# Calculate the correlation matrix
cor_matrix <- round(cor(df_cleaned), 2)
# Melt the correlation matrix
melted_cor_matrix <- melt(cor_matrix)
# Create the heatmap
ggplot(data = melted_cor_matrix, aes(x = Var1, y = Var2, fill = value)) +
geom_tile() +
geom_text(aes(label = value), size = 2) +
scale_fill_gradient2(low = "blue", high = "red", mid = "white", midpoint = 0, limit = c(-1, 1), space = "Lab", name="Correlation") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1),
axis.title.x = element_blank(), axis.title.y = element_blank(), panel.background = element_blank()) +
ggtitle("Data Correlation")
Features with a correlation value > 0.80:
ExitRates - BounceRates (0.90) redundant >> drop one VT_Returning_Visitor - VT_New_Visitor (0.97) >> drop one ProductRelated - ProductRelated_Duration (0.86) >> feature transformation
Feature selection
# Loại bỏ các cột không mong muốn
df_selected <- df_cleaned %>%
select(-BounceRates, -Region, -VT_ReturningVisitor)
# Xem trước dữ liệu
head(df_selected)## Administrative Administrative_Duration Informational Informational_Duration
## 1 0 0 0 0
## 2 0 0 0 0
## 3 0 0 0 0
## 4 0 0 0 0
## 5 0 0 0 0
## 6 0 0 0 0
## ProductRelated ProductRelated_Duration ExitRates PageValues SpecialDay Month
## 1 1 0.000000 0.2000000 0 0 3
## 2 2 64.000000 0.1000000 0 0 3
## 3 1 0.000000 0.2000000 0 0 3
## 4 2 2.666667 0.1400000 0 0 3
## 5 10 627.500000 0.0500000 0 0 3
## 6 19 154.216667 0.0245614 0 0 3
## OperatingSystems Browser TrafficType Weekend Revenue VT_NewVisitor
## 1 1 1 1 0 0 0
## 2 2 6 12 0 0 0
## 3 4 1 14 0 0 0
## 4 3 6 15 0 0 0
## 5 3 7 15 1 0 0
## 6 2 6 14 0 0 0
## VT_OtherVisitor
## 1 0
## 2 0
## 3 0
## 4 0
## 5 0
## 6 0##Feature Transformation Transformation of three data sets that have a high correlation related to page types into the average duration per page opened
#Tạo ra ba cột mới bằng cách chia thời gian cho số trang tương ứng trong các cột Administrative, Informational, và ProductRelated
df_selected$Administrative_Duration_Page <- df_selected$Administrative_Duration / df_selected$Administrative
df_selected$Informational_Duration_Page <- df_selected$Informational_Duration / df_selected$Informational
df_selected$ProductRelated_Duration_Page <- df_selected$ProductRelated_Duration / df_selected$ProductRelated#Loại bỏ các cột gốc khỏi dataframe df_selected và lưu kết quả vào df_transformed.
data_transformed <- df_selected %>%
select(-Administrative, -Informational, -ProductRelated, -Administrative_Duration, -Informational_Duration, -ProductRelated_Duration)# Xử lý giá trị chia cho 0
data_transformed$Administrative_Duration_Page[is.na(data_transformed$Administrative_Duration_Page)] <- 0
data_transformed$Informational_Duration_Page[is.na(data_transformed$Informational_Duration_Page)] <- 0
data_transformed$ProductRelated_Duration_Page[is.na(data_transformed$ProductRelated_Duration_Page)] <- 0
# Lấy mẫu ngẫu nhiên 5 hàng từ dataframe
sample_n(data_transformed, 5)## ExitRates PageValues SpecialDay Month OperatingSystems Browser
## 1889 0.03181818 0.000000 0.0 6 2 2
## 7054 0.02068966 4.818947 0.0 9 4 1
## 4929 0.02077295 0.000000 0.4 7 2 10
## 3197 0.07200000 0.000000 0.0 7 3 6
## 3204 0.07129630 0.000000 0.8 7 2 6
## TrafficType Weekend Revenue VT_NewVisitor VT_OtherVisitor
## 1889 12 0 0 0 0
## 7054 13 0 1 0 0
## 4929 14 0 0 0 0
## 3197 14 1 0 0 0
## 3204 5 0 0 0 0
## Administrative_Duration_Page Informational_Duration_Page
## 1889 0.0 0
## 7054 82.6 0
## 4929 0.0 0
## 3197 0.0 0
## 3204 0.0 0
## ProductRelated_Duration_Page
## 1889 14.80682
## 7054 49.11190
## 4929 20.77000
## 3197 15.93333
## 3204 25.71759# Hiển thị ma trận tương quan
cor_matrix <- round(cor(data_transformed),2)
melted_cor_matrix <- melt(cor_matrix)
# Create the heatmap
ggplot(data = melted_cor_matrix, aes(x = Var1, y = Var2, fill = value)) +
geom_tile() +
geom_text(aes(label = value), size = 2) +
scale_fill_gradient2(low = "blue", high = "red", mid = "white", midpoint = 0, limit = c(-1, 1), space = "Lab", name="Correlation") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1),
axis.title.x = element_blank(), axis.title.y = element_blank(), panel.background = element_blank()) +
ggtitle("Data Correlation")
# Loại bỏ các cột phân loại
df_droped <- data_transformed %>%
select(-OperatingSystems, -Browser, -TrafficType, -Month)
# Lưu kết quả xử lý đặc trưng vào dataset data
df2<- df_droped
# Hiển thị thông tin về dataframe đã xử lý
str(df2)## 'data.frame': 12205 obs. of 10 variables:
## $ ExitRates : num 0.2 0.1 0.2 0.14 0.05 ...
## $ PageValues : num 0 0 0 0 0 0 0 0 0 0 ...
## $ SpecialDay : num 0 0 0 0 0 0 0.4 0 0.8 0.4 ...
## $ Weekend : num 0 0 0 0 1 0 0 1 0 0 ...
## $ Revenue : num 0 0 0 0 0 0 0 0 0 0 ...
## $ VT_NewVisitor : num 0 0 0 0 0 0 0 0 0 0 ...
## $ VT_OtherVisitor : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Administrative_Duration_Page: num 0 0 0 0 0 0 0 0 0 0 ...
## $ Informational_Duration_Page : num 0 0 0 0 0 0 0 0 0 0 ...
## $ ProductRelated_Duration_Page: num 0 32 0 1.33 62.75 ...II: Model and Evaluation
Split data
# Tách các đặc trưng và mục tiêu
X <- df2%>% select(-Revenue)
y <- df2$Revenue# Chia dữ liệu thành tập huấn luyện và tập kiểm tra
set.seed(42)
trainIndex <- createDataPartition(y, p = 0.75, list = FALSE)
X_train_raw <- X[trainIndex, ]
X_test_raw <- X[-trainIndex, ]
y_train <- y[trainIndex]
y_test <- y[-trainIndex]# Hiển thị thông tin về các tập dữ liệu
str(X_train_raw)## 'data.frame': 9154 obs. of 9 variables:
## $ ExitRates : num 0.2 0.1 0.2 0.14 0.05 ...
## $ PageValues : num 0 0 0 0 0 0 0 0 0 0 ...
## $ SpecialDay : num 0 0 0 0 0 0.4 0 0.8 0 0 ...
## $ Weekend : num 0 0 0 0 1 0 1 0 0 0 ...
## $ VT_NewVisitor : num 0 0 0 0 0 0 0 0 0 0 ...
## $ VT_OtherVisitor : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Administrative_Duration_Page: num 0 0 0 0 0 0 0 0 0 0 ...
## $ Informational_Duration_Page : num 0 0 0 0 0 0 0 0 0 0 ...
## $ ProductRelated_Duration_Page: num 0 32 0 1.33 62.75 ...str(X_test_raw)## 'data.frame': 3051 obs. of 9 variables:
## $ ExitRates : num 0.0246 0.0222 0.0667 0.0258 0.2 ...
## $ PageValues : num 0 0 0 0 0 ...
## $ SpecialDay : num 0 0.4 0 0.4 0 0 0 0 0.4 0 ...
## $ Weekend : num 0 0 0 0 0 0 0 0 0 0 ...
## $ VT_NewVisitor : num 0 0 0 0 0 0 0 0 0 0 ...
## $ VT_OtherVisitor : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Administrative_Duration_Page: num 0 0 0 0 0 0 0 0 6 0 ...
## $ Informational_Duration_Page : num 0 0 0 0 0 0 0 0 0 0 ...
## $ ProductRelated_Duration_Page: num 8.12 246 131.67 25.48 0 ...Scaler transformation
Bộ chuẩn hóa này sẽ chuẩn hóa các đặc trưng bằng cách loại bỏ trung bình và chia cho độ lệch chuẩn để có giá trị trung bình là 0 và độ lệch chuẩn là 1.
library(caret)
# Khởi tạo bộ chuẩn hóa (Scaler) chuẩn hóa dữ liệu bằng cách loại bỏ trung bình và chia cho độ lệch chuẩn.
scaler <- preProcess(X_train_raw, method = c("center", "scale"))# Chuẩn hóa dữ liệu huấn luyện (X_train)
X_train <- predict(scaler, X_train_raw)
# Chuẩn hóa dữ liệu kiểm tra (X_test)
X_test <- predict(scaler, X_test_raw)# Chuyển đổi kết quả chuẩn hóa thành dataframe
X_train <- as.data.frame(X_train)
X_test <- as.data.frame(X_test)
# Đặt tên cột cho dataframe
colnames(X_train) <- colnames(X_train_raw)
colnames(X_test) <- colnames(X_test_raw)
# Hiển thị thông tin về các dataframe đã chuẩn hóa
str(X_train)## 'data.frame': 9154 obs. of 9 variables:
## $ ExitRates : num 3.429 1.266 3.429 2.132 0.185 ...
## $ PageValues : num -0.321 -0.321 -0.321 -0.321 -0.321 ...
## $ SpecialDay : num -0.309 -0.309 -0.309 -0.309 -0.309 ...
## $ Weekend : num -0.559 -0.559 -0.559 -0.559 1.789 ...
## $ VT_NewVisitor : num -0.406 -0.406 -0.406 -0.406 -0.406 ...
## $ VT_OtherVisitor : num -0.0832 -0.0832 -0.0832 -0.0832 -0.0832 ...
## $ Administrative_Duration_Page: num -0.432 -0.432 -0.432 -0.432 -0.432 ...
## $ Informational_Duration_Page : num -0.232 -0.232 -0.232 -0.232 -0.232 ...
## $ ProductRelated_Duration_Page: num -0.839 -0.132 -0.839 -0.809 0.548 ...str(X_test)## 'data.frame': 3051 obs. of 9 variables:
## $ ExitRates : num -0.365 -0.416 0.545 -0.338 3.429 ...
## $ PageValues : num -0.321 -0.321 -0.321 -0.321 -0.321 ...
## $ SpecialDay : num -0.309 1.692 -0.309 1.692 -0.309 ...
## $ Weekend : num -0.559 -0.559 -0.559 -0.559 -0.559 ...
## $ VT_NewVisitor : num -0.406 -0.406 -0.406 -0.406 -0.406 ...
## $ VT_OtherVisitor : num -0.0832 -0.0832 -0.0832 -0.0832 -0.0832 ...
## $ Administrative_Duration_Page: num -0.432 -0.432 -0.432 -0.432 -0.432 ...
## $ Informational_Duration_Page : num -0.232 -0.232 -0.232 -0.232 -0.232 ...
## $ ProductRelated_Duration_Page: num -0.659 4.597 2.071 -0.275 -0.839 ...str(y_test)## num [1:3051] 0 0 0 0 0 0 0 0 0 0 ...str(y_train)## num [1:9154] 0 0 0 0 0 0 0 0 0 0 ...Handling imbalance
# Tính tỷ lệ phần trăm của các giá trị mục tiêu
percentage_target_value <- prop.table(table(y_train)) * 100
# Hiển thị kết quả
print(percentage_target_value)## y_train
## 0 1
## 84.08346 15.91654Oversampling
library(caret)
library(ROSE)## Loaded ROSE 0.0-4smote_data <- function(data, target, perc.over = 100, perc.under = 200) {
# Tạo công thức
formula <- as.formula(paste(target, "~ ."))
# Áp dụng SMOTE
data_smote <- ROSE(formula, data = data, seed = 42, N = perc.over * nrow(data) / 100)$data
return(data_smote)
}
# Kết hợp dữ liệu huấn luyện thành một dataframe
data_train <- data.frame(X_train, Revenue = y_train)
# Áp dụng SMOTE
data_train <- data.frame(X_train, Revenue = y_train)
data_smote <- ROSE(Revenue ~ ., data = data_train, seed = 42, N = 10810)$data
X_over_smote <- data_smote %>% select(-Revenue)
y_over_smote <- data_smote$Revenue
# Tách lại các đặc trưng và mục tiêu sau khi áp dụng SMOTE
X_over_smote <- data_smote %>% select(-Revenue)
y_over_smote <- data_smote$Revenue
print('AFTER oversampling (smote)')## [1] "AFTER oversampling (smote)"print(table(y_over_smote))## y_over_smote
## 0 1
## 5391 5419III: Model & Validation
- Thiết lập 10-fold cross-validation train_control <- trainControl(method = “cv”, number = 10)
- Huấn luyện mô hình với 10-fold cross-validation set.seed(42) model
<- train( X, y, method = “your_model_method”,
- Thay thế “your_model_method” bằng phương pháp mô hình bạn muốn sử dụng trControl = train_control )
Model Fitting
Logistic Regression
# Thiết lập 10-fold cross-validation
train_control <- trainControl(method = "cv", number = 10)
# Đảm bảo y_over_smote là yếu tố với hai mức
y_over_smote <- as.factor(y_over_smote)
# Khởi tạo và huấn luyện mô hình Logistic Regression
model01 <- caret::train(Revenue ~ ., data = data.frame(X_over_smote, Revenue = y_over_smote), method = "glm", family = binomial(link = "logit"), trControl = train_control)
# Dự đoán trên tập dữ liệu kiểm tra
Y_pred <- predict(model01, newdata = data.frame(X_test))# Tính toán ma trận nhầm lẫn
confusion_matrix <- confusionMatrix(as.factor(Y_pred), as.factor(y_test))
print("Confusion Matrix:")## [1] "Confusion Matrix:"print(confusion_matrix$table)## Reference
## Prediction 0 1
## 0 2347 148
## 1 253 303# Tính toán báo cáo phân loại
classification_report <- confusionMatrix(as.factor(Y_pred), as.factor(y_test))
print("Classification Report:")## [1] "Classification Report:"print(classification_report)## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 2347 148
## 1 253 303
##
## Accuracy : 0.8686
## 95% CI : (0.8561, 0.8804)
## No Information Rate : 0.8522
## P-Value [Acc > NIR] : 0.005249
##
## Kappa : 0.5241
##
## Mcnemar's Test P-Value : 2.064e-07
##
## Sensitivity : 0.9027
## Specificity : 0.6718
## Pos Pred Value : 0.9407
## Neg Pred Value : 0.5450
## Prevalence : 0.8522
## Detection Rate : 0.7693
## Detection Prevalence : 0.8178
## Balanced Accuracy : 0.7873
##
## 'Positive' Class : 0
## library(pROC)## Type 'citation("pROC")' for a citation.##
## Attaching package: 'pROC'## The following objects are masked from 'package:stats':
##
## cov, smooth, var# Tính toán điểm ROC AUC
roc_auc <- roc(y_test, as.numeric(predict(model01, newdata = data.frame(X_test), type = "prob")[,2]))## Setting levels: control = 0, case = 1## Setting direction: controls < casesprint(paste("ROC AUC Score:", auc(roc_auc)))## [1] "ROC AUC Score: 0.86842316220365"library(pROC)
# Vẽ đường cong ROC
plot(roc_auc, main = "ROC Curve", col = "blue")
abline(a = 0, b = 1, lty = 2, col = "red")
XGBoost
library(xgboost)##
## Attaching package: 'xgboost'## The following object is masked from 'package:dplyr':
##
## slice# Giả sử X_train và X_test là data.frame
X_train <- as.matrix(X_over_smote)
X_test <- as.matrix(X_test)
# Huấn luyện mô hình XGBoost
model <- xgboost(data = X_train, label = as.matrix(y_over_smote), nrounds = 100, objective = "binary:logistic")## [1] train-logloss:0.544622
## [2] train-logloss:0.461603
## [3] train-logloss:0.409827
## [4] train-logloss:0.374455
## [5] train-logloss:0.350490
## [6] train-logloss:0.330487
## [7] train-logloss:0.316766
## [8] train-logloss:0.304273
## [9] train-logloss:0.296073
## [10] train-logloss:0.286532
## [11] train-logloss:0.279698
## [12] train-logloss:0.272529
## [13] train-logloss:0.266908
## [14] train-logloss:0.263923
## [15] train-logloss:0.258292
## [16] train-logloss:0.255442
## [17] train-logloss:0.249063
## [18] train-logloss:0.247267
## [19] train-logloss:0.244668
## [20] train-logloss:0.239599
## [21] train-logloss:0.238547
## [22] train-logloss:0.234303
## [23] train-logloss:0.232029
## [24] train-logloss:0.228122
## [25] train-logloss:0.227142
## [26] train-logloss:0.226417
## [27] train-logloss:0.224449
## [28] train-logloss:0.221948
## [29] train-logloss:0.220307
## [30] train-logloss:0.219693
## [31] train-logloss:0.218975
## [32] train-logloss:0.214492
## [33] train-logloss:0.213804
## [34] train-logloss:0.211289
## [35] train-logloss:0.209887
## [36] train-logloss:0.208542
## [37] train-logloss:0.206324
## [38] train-logloss:0.203969
## [39] train-logloss:0.202789
## [40] train-logloss:0.201205
## [41] train-logloss:0.200022
## [42] train-logloss:0.197530
## [43] train-logloss:0.196462
## [44] train-logloss:0.195245
## [45] train-logloss:0.192352
## [46] train-logloss:0.190679
## [47] train-logloss:0.186653
## [48] train-logloss:0.184917
## [49] train-logloss:0.183338
## [50] train-logloss:0.181282
## [51] train-logloss:0.179409
## [52] train-logloss:0.177931
## [53] train-logloss:0.177506
## [54] train-logloss:0.177255
## [55] train-logloss:0.176491
## [56] train-logloss:0.176199
## [57] train-logloss:0.175804
## [58] train-logloss:0.173088
## [59] train-logloss:0.170337
## [60] train-logloss:0.167288
## [61] train-logloss:0.165413
## [62] train-logloss:0.164251
## [63] train-logloss:0.162799
## [64] train-logloss:0.162124
## [65] train-logloss:0.161705
## [66] train-logloss:0.160309
## [67] train-logloss:0.159792
## [68] train-logloss:0.159479
## [69] train-logloss:0.158852
## [70] train-logloss:0.157534
## [71] train-logloss:0.156413
## [72] train-logloss:0.155603
## [73] train-logloss:0.154169
## [74] train-logloss:0.153736
## [75] train-logloss:0.152993
## [76] train-logloss:0.150349
## [77] train-logloss:0.148095
## [78] train-logloss:0.146817
## [79] train-logloss:0.145613
## [80] train-logloss:0.143678
## [81] train-logloss:0.142789
## [82] train-logloss:0.141315
## [83] train-logloss:0.140731
## [84] train-logloss:0.139220
## [85] train-logloss:0.137496
## [86] train-logloss:0.136746
## [87] train-logloss:0.135080
## [88] train-logloss:0.134181
## [89] train-logloss:0.133229
## [90] train-logloss:0.132828
## [91] train-logloss:0.132140
## [92] train-logloss:0.131743
## [93] train-logloss:0.131448
## [94] train-logloss:0.130327
## [95] train-logloss:0.128992
## [96] train-logloss:0.127494
## [97] train-logloss:0.126902
## [98] train-logloss:0.125582
## [99] train-logloss:0.124587
## [100] train-logloss:0.123664# Dự đoán với iteration_range
predictions <- predict(model, X_test, iteration_range = c(0, 50))# Chuyển đổi dự đoán thành nhãn phân loại
predicted_labels <- ifelse(predictions > 0.5, 1, 0)
# Tính toán ma trận nhầm lẫn
confusion_matrix <- confusionMatrix(as.factor(predicted_labels), as.factor(y_test))
print("Confusion Matrix:")## [1] "Confusion Matrix:"print(confusion_matrix$table)## Reference
## Prediction 0 1
## 0 2443 172
## 1 157 279# Tính toán báo cáo phân loại
classification_report <- confusionMatrix(as.factor(predicted_labels), as.factor(y_test))
print("Classification Report:")
print(classification_report)library(pROC)
# Tính toán điểm ROC AUC
roc_auc <- roc(y_test, predictions)## Setting levels: control = 0, case = 1## Setting direction: controls < casesprint(paste("ROC AUC Score:", auc(roc_auc)))## [1] "ROC AUC Score: 0.878136193075218"SVM
Support Vector Machine (SVM) với kernel Radial, còn được gọi là Radial Basis Function (RBF) kernel, là một thuật toán học máy mạnh mẽ được sử dụng chủ yếu cho các bài toán phân loại và hồi quy. Dưới đây là một số điểm chính về thuật toán này: 1. Khái niệm cơ bản SVM là một thuật toán giám sát (supervised learning) nhằm tìm ra một siêu phẳng (hyperplane) tốt nhất để phân tách các lớp dữ liệu trong không gian nhiều chiều. Khi dữ liệu không thể phân tách tuyến tính, SVM sử dụng các hàm kernel để ánh xạ dữ liệu sang không gian cao hơn, nơi dữ liệu có thể phân tách tuyến tính. 2. Radial Basis Function (RBF) Kernel RBF kernel, hay Gaussian kernel, là một trong những hàm kernel phổ biến nhất được sử dụng trong SVM. Nó có khả năng ánh xạ dữ liệu từ không gian gốc sang không gian cao hơn một cách phi tuyến tính. Công thức của RBF kernel được định nghĩa như sau: k(x,z)=exp(−γ∣∣x−z∣∣2) Trong đó:
() và () là các điểm dữ liệu. () là tham số điều chỉnh, xác định mức độ ảnh hưởng của một điểm dữ liệu đến các điểm khác. Giá trị của (γ) càng lớn thì ảnh hưởng của một điểm dữ liệu càng nhỏ.
- Ưu điểm của SVM với RBF Kernel
Khả năng phân loại mạnh mẽ: SVM với RBF kernel có thể xử lý các bài toán phân loại phức tạp, nơi dữ liệu không thể phân tách tuyến tính. Hiệu suất cao: SVM thường cho kết quả tốt với các bộ dữ liệu có kích thước vừa phải và có thể tổng quát hóa tốt trên dữ liệu chưa thấy. Linh hoạt: RBF kernel có thể điều chỉnh để phù hợp với nhiều loại dữ liệu khác nhau bằng cách thay đổi tham số (γ).
- Ứng dụng SVM với RBF kernel được sử dụng rộng rãi trong nhiều lĩnh vực như:
Nhận dạng hình ảnh: Phân loại các đối tượng trong hình ảnh. Phân loại văn bản: Phân loại tài liệu, email spam, v.v. Sinh học: Phân loại các loại tế bào, gen, v.v.
Gaussian NB
#KNN ## Decision Tree ## Random Forest ## XGBoost ## AdaBoost
# Cài đặt các thư viện cần thiết
library(caret)
library(e1071)
library(randomForest)
library(xgboost)
library(adabag)
library(naivebayes)
library(MLmetrics)
# Hàm để so sánh các mô hình với 10-fold cross-validation
cv_comparison <- function(models, X, y) {
# Chuyển đổi biến mục tiêu thành phân loại nếu cần
if (!is.factor(y)) {
y <- as.factor(y)
}
# Sử dụng make.names để đảm bảo các mức của y là tên biến hợp lệ
levels(y) <- make.names(levels(y))
# Kiểm tra kích thước dữ liệu
if (nrow(X) != length(y)) {
stop("Số hàng của X và y không khớp nhau.")
}
# Tạo một data frame để lưu trữ kết quả
cv_accuracies <- data.frame()
# Thiết lập phương pháp cross-validation
train_control <- trainControl(method = "cv", number = 10, summaryFunction = multiClassSummary, classProbs = TRUE)
# Lặp qua các mô hình và thực hiện cross-validation
for (model in models) {
# Huấn luyện mô hình với cross-validation
fit <- train(X, y, method = model, trControl = train_control)
# Kiểm tra xem ROC có tồn tại trong fit$resample không
if ("ROC" %in% colnames(fit$resample)) {
recall_score <- mean(fit$resample$Recall, na.rm = TRUE)
precision_score <- mean(fit$resample$Precision, na.rm = TRUE)
accuracy_score <- mean(fit$resample$Accuracy, na.rm = TRUE)
auc_score <- mean(fit$resample$ROC, na.rm = TRUE)
f1_score <- mean(fit$resample$F1, na.rm = TRUE)
} else {
recall_score <- mean(fit$resample$Recall, na.rm = TRUE)
precision_score <- mean(fit$resample$Precision, na.rm = TRUE)
accuracy_score <- mean(fit$resample$Accuracy, na.rm = TRUE)
auc_score <- NA
f1_score <- mean(fit$resample$F1, na.rm = TRUE)
}
# Thêm kết quả vào data frame
cv_accuracies <- rbind(cv_accuracies, data.frame(Model = model, Recall = recall_score, Precision = precision_score, Accuracy = accuracy_score, AUC = auc_score, F1 = f1_score))
}
return(cv_accuracies)
}
# Ví dụ sử dụng hàm cv_comparison
models <- c("glm", "rf", "rpart", "svmLinear", "knn", "xgbTree", "adaboost", "naive_bayes")
X <- X_over_smote
y <- y_over_smote
results <- cv_comparison(models, X, y)
print(results)LogisticRegression RandomForestClassifier XGBClassifier AdaBoostClassifier DecisionTreeClassifier KNeighborsClassifier SVC GaussianNB Recall 0.82 0.71 0.68 0.73 0.63 0.57 0.80 0.86 Precision 0.54 0.61 0.61 0.61 0.51 0.49 0.57 0.37 Accuracy 0.86 0.89 0.88 0.88 0.85 0.84 0.87 0.75 AUC 0.91 0.91 0.91 0.91 0.76 0.83 0.89 0.87 F1 0.86 0.89 0.88 0.88 0.85 0.84 0.87 0.75