##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(readr)
library(knitr)
da <- read.csv("C:/Users/ASUS/Desktop/marketing_campaign_dataset.csv")
head(da)1. Company: Tên công ty thực hiện chiến dịch.
2. Campaign_Type: Loại hình chiến dịch marketing.
- Email: Email marketing.
- Influencer: Tiếp thị qua người có sức ảnh hưởng.
- Display: Quảng cáo hiển thị.
- Search: Quảng cáo tìm kiếm.
- Social Media: Mạng xã hội.
3. Target_Audience: Nhóm đối tượng mục tiêu
- Phân theo giới tính và độ tuổi.
4. Duration: Thời gian chạy chiến dịch (ngày).
5. Channel_Used: Kênh phân phối chiến dịch.
- Google Ads, YouTube, Instagram, Facebook, Email, Website.
6. Conversion_Rate: Tỷ lệ chuyển đổi - phần trăm người dùng
thực hiện hành động mong muốn.
7. Acquisition_Cost: Chi phí thu hút khách hàng.
8. ROI (Return on Investment): Tỷ suất hoàn vốn.
9. Location: Địa điểm triển khai chiến dịch.
10. Language: Ngôn ngữ sử dụng trong chiến dịch.
11. Clicks: Số lượt nhấp chuột vào quảng cáo.
12. Impressions: Số lần quảng cáo được hiển thị.
13. Engagement_Score: Đo lường mức độ tương tác.
14. Customer_Segment: Phân khúc khách hàng.
- Health & Wellness: Sức khỏe.
- Fashionistas: Thời trang.
- Outdoor Adventurers: Du lịch ngoài trời.
- Tech Enthusiasts: Công nghệ.
- Foodies: Ẩm thực.
15. Date: Ngày thực hiện chiến dịch.
## [1] 200000 16
Dữ liệu có 16 biến và 2000 quan sát
## [1] 0
## kiểm tra trùng lặp theo từng biến
variables <- c("Company", "Campaign_Type", "Target_Audience", "Duration",
"Channel_Used", "Conversion_Rate", "Acquisition_Cost", "ROI",
"Location", "Language", "Clicks", "Impressions", "Engagement_Score",
"Customer_Segment")
for(var in variables) {
cat("Số trùng lặp cho", var, ":", sum(duplicated(da[[var]])), "\n")
} ## Số trùng lặp cho Company : 199995
## Số trùng lặp cho Campaign_Type : 199995
## Số trùng lặp cho Target_Audience : 199995
## Số trùng lặp cho Duration : 199996
## Số trùng lặp cho Channel_Used : 199994
## Số trùng lặp cho Conversion_Rate : 199985
## Số trùng lặp cho Acquisition_Cost : 184999
## Số trùng lặp cho ROI : 199399
## Số trùng lặp cho Location : 199995
## Số trùng lặp cho Language : 199995
## Số trùng lặp cho Clicks : 199099
## Số trùng lặp cho Impressions : 190999
## Số trùng lặp cho Engagement_Score : 199990
## Số trùng lặp cho Customer_Segment : 199995
## [1] "Campaign_ID" "Company" "Campaign_Type" "Target_Audience"
## [5] "Duration" "Channel_Used" "Conversion_Rate" "Acquisition_Cost"
## [9] "ROI" "Location" "Language" "Clicks"
## [13] "Impressions" "Engagement_Score" "Customer_Segment" "Date"
## 'data.frame': 200000 obs. of 16 variables:
## $ Campaign_ID : int 1 2 3 4 5 6 7 8 9 10 ...
## $ Company : chr "Innovate Industries" "NexGen Systems" "Alpha Innovations" "DataTech Solutions" ...
## $ Campaign_Type : chr "Email" "Email" "Influencer" "Display" ...
## $ Target_Audience : chr "Men 18-24" "Women 35-44" "Men 25-34" "All Ages" ...
## $ Duration : chr "30 days" "60 days" "30 days" "60 days" ...
## $ Channel_Used : chr "Google Ads" "Google Ads" "YouTube" "YouTube" ...
## $ Conversion_Rate : num 0.04 0.12 0.07 0.11 0.05 0.07 0.13 0.08 0.09 0.09 ...
## $ Acquisition_Cost: chr "$16,174.00" "$11,566.00" "$10,200.00" "$12,724.00" ...
## $ ROI : num 6.29 5.61 7.18 5.55 6.5 4.36 2.86 5.55 6.73 3.78 ...
## $ Location : chr "Chicago" "New York" "Los Angeles" "Miami" ...
## $ Language : chr "Spanish" "German" "French" "Mandarin" ...
## $ Clicks : int 506 116 584 217 379 100 817 624 861 642 ...
## $ Impressions : int 1922 7523 7698 1820 4201 1643 8749 7854 1754 3856 ...
## $ Engagement_Score: int 6 7 1 7 3 1 10 7 6 3 ...
## $ Customer_Segment: chr "Health & Wellness" "Fashionistas" "Outdoor Adventurers" "Health & Wellness" ...
## $ Date : chr "2021-01-01" "2021-01-02" "2021-01-03" "2021-01-04" ...
## Chuyển đổi kiểu dữ liệu
da$Date <- as.Date(da$Date, format = "%Y-%m-%d")
da$Acquisition_Cost <- as.numeric(gsub("[\\$,]", "", da$Acquisition_Cost))
da$Duration <- as.numeric(gsub(" days", "", da$Duration))
str(da)## 'data.frame': 200000 obs. of 16 variables:
## $ Campaign_ID : int 1 2 3 4 5 6 7 8 9 10 ...
## $ Company : chr "Innovate Industries" "NexGen Systems" "Alpha Innovations" "DataTech Solutions" ...
## $ Campaign_Type : chr "Email" "Email" "Influencer" "Display" ...
## $ Target_Audience : chr "Men 18-24" "Women 35-44" "Men 25-34" "All Ages" ...
## $ Duration : num 30 60 30 60 15 15 60 45 15 15 ...
## $ Channel_Used : chr "Google Ads" "Google Ads" "YouTube" "YouTube" ...
## $ Conversion_Rate : num 0.04 0.12 0.07 0.11 0.05 0.07 0.13 0.08 0.09 0.09 ...
## $ Acquisition_Cost: num 16174 11566 10200 12724 16452 ...
## $ ROI : num 6.29 5.61 7.18 5.55 6.5 4.36 2.86 5.55 6.73 3.78 ...
## $ Location : chr "Chicago" "New York" "Los Angeles" "Miami" ...
## $ Language : chr "Spanish" "German" "French" "Mandarin" ...
## $ Clicks : int 506 116 584 217 379 100 817 624 861 642 ...
## $ Impressions : int 1922 7523 7698 1820 4201 1643 8749 7854 1754 3856 ...
## $ Engagement_Score: int 6 7 1 7 3 1 10 7 6 3 ...
## $ Customer_Segment: chr "Health & Wellness" "Fashionistas" "Outdoor Adventurers" "Health & Wellness" ...
## $ Date : Date, format: "2021-01-01" "2021-01-02" ...
Các biến định lượng bao gồm: Conversion_Rate, ROI, Clicks,
Impressions, Engagements_Score, Acquisition_Cost, Duration
Các biến định tính: Company, Campaign_Type, Target_Audience,
Channel_Used, Location, Language, Customer_Segment, Date
## [1] 0
## Campaign_ID Company Campaign_Type Target_Audience
## 0 0 0 0
## Duration Channel_Used Conversion_Rate Acquisition_Cost
## 0 0 0 0
## ROI Location Language Clicks
## 0 0 0 0
## Impressions Engagement_Score Customer_Segment Date
## 0 0 0 0
Dữ liệu không có giá trị bị thiếu
## 1. Phân tổ theo hiệu quả chiến dịch (ROI)
da$ROI_Group <- cut(da$ROI,
breaks = c(-Inf, 4, 7, Inf),
labels = c("ROI thấp", "ROI trung bình", "ROI cao"))
roi_table <- as.data.frame(table(da$ROI_Group))
colnames(roi_table) <- c("Nhóm ROI", "Số lượng")
knitr::kable(roi_table, align = "c", caption = "Bảng 1. Phân tổ theo hiệu quả chiến dịch (ROI)")| Nhóm ROI | Số lượng |
|---|---|
| ROI thấp | 66822 |
| ROI trung bình | 99877 |
| ROI cao | 33301 |
Phân tổ theo hiệu quả chiến dịch (ROI) thành 3 nhóm:
- ROI thấp: Dưới 4
- ROI trung bình: Từ 4 đến 7
- ROI cao: Trên 7
## 2. Phân tổ theo quy mô ngân sách
da$Budget_Group <- cut(da$Acquisition_Cost,
breaks = c(-Inf, 10000, 15000, Inf),
labels = c("Ngân sách nhỏ", "Ngân sách trung bình", "Ngân sách lớn"))
budget_table <- as.data.frame(table(da$Budget_Group))
colnames(budget_table) <- c("Nhóm ngân sách", "Số lượng")
knitr::kable(budget_table, align = "c", caption = "Bảng 2. Phân tổ theo quy mô ngân sách")| Nhóm ngân sách | Số lượng |
|---|---|
| Ngân sách nhỏ | 66704 |
| Ngân sách trung bình | 66495 |
| Ngân sách lớn | 66801 |
Phân tổ theo quy mô ngân sách thành 3 nhóm:
- Ngân sách nhỏ: Dưới $10,000
- Ngân sách trung bình: Từ $10,000 đến $15,000
- Ngân sách lớn: Trên $15,000
## 3. Phân tổ theo mức độ tương tác
da$Engagement_Group <- cut(da$Engagement_Score,
breaks = c(-Inf, 4, 7, Inf),
labels = c("Tương tác thấp", "Tương tác trung bình", "Tương tác cao"))
engage_table <- as.data.frame(table(da$Engagement_Group))
colnames(engage_table) <- c("Nhóm tương tác", "Số lượng")
knitr::kable(engage_table, align = "c", caption = "Bảng 3. Phân tổ theo mức độ tương tác")| Nhóm tương tác | Số lượng |
|---|---|
| Tương tác thấp | 80228 |
| Tương tác trung bình | 59838 |
| Tương tác cao | 59934 |
Phân tổ theo mức độ tương tác thành 3 nhóm:
- Tương tác thấp: Dưới 4
- Tương tác trung bình: Từ 4 đến 7
- Tương tác cao: Trên 7
## 4. Phân tổ theo hiệu suất chuyển đổi
da$Conversion_Group <- cut(da$Conversion_Rate,
breaks = c(-Inf, 0.05, 0.10, Inf),
labels = c("Chuyển đổi kém", "Chuyển đổi khá", "Chuyển đổi tốt"))
conv_table <- as.data.frame(table(da$Conversion_Group))
colnames(conv_table) <- c("Nhóm chuyển đổi", "Số lượng")
knitr::kable(conv_table, align = "c", caption = "Bảng 4. Phân tổ theo hiệu suất chuyển đổi")| Nhóm chuyển đổi | Số lượng |
|---|---|
| Chuyển đổi kém | 64117 |
| Chuyển đổi khá | 71468 |
| Chuyển đổi tốt | 64415 |
Phân tổ theo hiệu suất chuyển đổi thành 3 nhóm:
- Chuyển đổi kém: Dưới 5%
- Chuyển đổi khá: Từ 5% đến 10%
- Chuyển đổi tốt: Trên 10%
## Thống kê mô tả các biến định lượng
sapply(da[c("Conversion_Rate", "ROI", "Clicks", "Impressions", "Engagement_Score", "Acquisition_Cost", "Duration")],
function(x) c(Mean=mean(x, na.rm=TRUE),
Median=median(x, na.rm=TRUE),
SD=sd(x, na.rm=TRUE),
var=var(x, na.rm=TRUE),
Min=min(x, na.rm=TRUE),
Max=max(x, na.rm=TRUE)))## Conversion_Rate ROI Clicks Impressions Engagement_Score
## Mean 0.080069650 5.002438 549.7720 5507.302 5.494710
## Median 0.080000000 5.010000 550.0000 5517.500 5.000000
## SD 0.040601649 1.734488 260.0191 2596.864 2.872581
## var 0.001648494 3.008450 67609.9094 6743704.121 8.251723
## Min 0.010000000 2.000000 100.0000 1000.000 1.000000
## Max 0.150000000 8.000000 1000.0000 10000.000 10.000000
## Acquisition_Cost Duration
## Mean 12504.393 37.50397
## Median 12496.500 30.00000
## SD 4337.665 16.74672
## var 18815333.705 280.45264
## Min 5000.000 15.00000
## Max 20000.000 60.00000
## Thống kê tần số các biến định tính
lapply(da[c("Company", "Campaign_Type", "Target_Audience", "Duration",
"Channel_Used", "Location", "Language", "Customer_Segment" )],
table)## $Company
##
## Alpha Innovations DataTech Solutions Innovate Industries NexGen Systems
## 40051 40012 39709 39991
## TechCorp
## 40237
##
## $Campaign_Type
##
## Display Email Influencer Search Social Media
## 39987 39870 40169 40157 39817
##
## $Target_Audience
##
## All Ages Men 18-24 Men 25-34 Women 25-34 Women 35-44
## 40019 40258 40023 40013 39687
##
## $Duration
##
## 15 30 45 60
## 49779 50255 50100 49866
##
## $Channel_Used
##
## Email Facebook Google Ads Instagram Website YouTube
## 33599 32819 33438 33392 33360 33392
##
## $Location
##
## Chicago Houston Los Angeles Miami New York
## 40010 39750 39947 40269 40024
##
## $Language
##
## English French German Mandarin Spanish
## 39896 39764 39983 40255 40102
##
## $Customer_Segment
##
## Fashionistas Foodies Health & Wellness Outdoor Adventurers
## 39742 40208 39888 40011
## Tech Enthusiasts
## 40151
DL3 <- da
# PHÂN TÍCH ROI RIÊNG, CÔNG TY RIÊNG VÀ ROI KẾT HỢP CÔNG TY
# 1. PHÂN TÍCH RIÊNG BIẾN ROI
ROI_stats <- summary(DL3$ROI)
ROI_table <- data.frame(
Thống_kê = names(ROI_stats),
Giá_trị = as.numeric(ROI_stats)
)
kable(ROI_table,
caption = "Bảng thống kê mô tả ROI",
align = "c",
col.names = c("Thống kê", "Giá trị"))| Thống kê | Giá trị |
|---|---|
| Min. | 2.000000 |
| 1st Qu. | 3.500000 |
| Median | 5.010000 |
| Mean | 5.002438 |
| 3rd Qu. | 6.510000 |
| Max. | 8.000000 |
# 2. PHÂN TÍCH RIÊNG BIẾN CÔNG TY
Company_dist <- table(DL3$Company)
company_table <- data.frame(
"Công ty" = names(Company_dist),
"Số lượng chiến dịch" = as.numeric(Company_dist),
"Tỷ lệ (%)" = round( prop.table(Company_dist) *100, 1))
knitr::kable(
company_table,
align = "c",
caption = "Bảng: Phân bố chiến dịch theo công ty và tỷ lệ phần trăm")| Công.ty | Số.lượng.chiến.dịch | Tỷ.lệ…..Var1 | Tỷ.lệ…..Freq |
|---|---|---|---|
| Alpha Innovations | 40051 | Alpha Innovations | 20.0 |
| DataTech Solutions | 40012 | DataTech Solutions | 20.0 |
| Innovate Industries | 39709 | Innovate Industries | 19.9 |
| NexGen Systems | 39991 | NexGen Systems | 20.0 |
| TechCorp | 40237 | TechCorp | 20.1 |
# 3. ROI KẾT HỢP VỚI CÔNG TY
ROI_by_Company <- aggregate(ROI ~ Company, DL3, function(x) c(
Số_chiến_dịch = length(x),
ROI_trung_bình = round(mean(x), 2),
ROI_cao = sum(x > 7),
Tỷ_lệ_ROI_cao = paste0(round(sum(x > 7)/length(x)*100, 1), "%")
))
ROI_by_Company <- ROI_by_Company[order(ROI_by_Company$ROI[,2]), ]
print(ROI_by_Company)## Company ROI.Số_chiến_dịch ROI.ROI_trung_bình ROI.ROI_cao
## 4 NexGen Systems 39991 4.99 6600
## 3 Innovate Industries 39709 5 6558
## 1 Alpha Innovations 40051 5.01 6813
## 2 DataTech Solutions 40012 5.01 6658
## 5 TechCorp 40237 5.01 6672
## ROI.Tỷ_lệ_ROI_cao
## 4 16.5%
## 3 16.5%
## 1 17%
## 2 16.6%
## 5 16.6%
conclusion <- data.frame(
Tiêu_chí = c("Nhiều chiến dịch nhất", "ROI TB cao nhất", "Tỷ lệ ROI cao nhất"),
Kết_quả = c(
names(which.max(Company_dist)),
with(ROI_by_Company, paste(Company[which.max(ROI[,2])], "(ROI =", ROI[which.max(ROI[,2]),2], ")")),
with(ROI_by_Company, paste(Company[which.max(as.numeric(sub('%','',ROI[,4])))], "(", ROI[which.max(as.numeric(sub('%','',ROI[,4]))),4], ")"))
)
)
knitr::kable(conclusion, align="c", caption="Bảng Kết Luận Tổng Hợp")| Tiêu_chí | Kết_quả |
|---|---|
| Nhiều chiến dịch nhất | TechCorp |
| ROI TB cao nhất | Alpha Innovations (ROI = 5.01 ) |
| Tỷ lệ ROI cao nhất | Alpha Innovations ( 17% ) |