library(readr)
library(data.table)
library(ggplot2)
library(dplyr)
library(skimr)
library(psych)
library(csv)
library(DT)
library(pander)
library(formattable)
library(htmltools)
library(DescTools)
library(epitools)
library(MASS)
library(fmsb)
library(brglm2)
library(janitor)
library(lubridate)
library(ggridges)

CHƯƠNG 1. Movie Dataset for Analytics & Visualization

1.1 Giới thiệu dữ liệu

Bộ dữ liệu Movie Dataset for Analytics & Visualization gồm 999.999 quan sát phim tổng hợp, mô phỏng đặc trưng thực tế của ngành điện ảnh toàn cầu trong giai đoạn 1950 – 2025. Mỗi phim có ngày phát hành ngẫu nhiên trong năm tương ứng và được phân loại theo tám thể loại chính như Drama, Action, Comedy, Thriller, Romance, Sci-Fi, Horror và Documentary, kèm thông tin về quốc gia sản xuất và thời lượng.

Ngoài ra các biến tài chính trong bộ dữ liệu gồm BudgetUSD, US_BoxOfficeUSD, Global_BoxOfficeUSD, Opening_Day_SalesUSD, One_Week_SalesUSD, cùng các chỉ số phản hồi khán giả như IMDbRating, RottenTomatoesScore, NumVotesIMDb, NumVotesRT, và thông tin diễn viên gồm Director và LeadActor. Các biến này thể hiện mối quan hệ giữa đầu tư, doanh thu và phản ứng của thị trường.

Bộ dữ liệu được xây dựng nhằm phục vụ mục đích phân tích tài chính, đánh giá hiệu quả đầu tư và dự báo doanh thu trong ngành điện ảnh. Với quy mô lớn và cấu trúc đa chiều, dữ liệu thích hợp cho phân tích định lượng, trực quan hóa và mô hình hóa trong lĩnh vực kinh tế – tài chính ứng dụng.

1.1.1 Đọc dữ liệu

d <- read_csv("E:/archive/movies_dataset.csv")

1.1.2 Tên các biến

names(d)

##  [1] "MovieID"              "Title"                "Genre"               
##  [4] "ReleaseYear"          "ReleaseDate"          "Country"             
##  [7] "BudgetUSD"            "US_BoxOfficeUSD"      "Global_BoxOfficeUSD" 
## [10] "Opening_Day_SalesUSD" "One_Week_SalesUSD"    "IMDbRating"          
## [13] "RottenTomatoesScore"  "NumVotesIMDb"         "NumVotesRT"          
## [16] "Director"             "LeadActor"

d <- d %>%
  rename(
    IDPhim = MovieID,
    Title = Title,
    Genre = Genre,
    NamPhatHanh = ReleaseYear,
    NgayPhatHanh = ReleaseDate,
    QuocGia = Country,
    KinhPhiUSD = BudgetUSD,
    DT_MyUSD = US_BoxOfficeUSD,
    DT_ToanCauUSD = Global_BoxOfficeUSD,
    DT_NgayDauUSD = Opening_Day_SalesUSD,
    DT_TuanDauUSD = One_Week_SalesUSD,
    XepHang = IMDbRating,
    ĐánhGiá = RottenTomatoesScore,
    SoBinhChonIMDb = NumVotesIMDb,
    SoBinhChonRT = NumVotesRT,
    DaoDien = Director,
    DienVienChinh = LeadActor
  )

1.1.3 Các dòng đầu tiên

head(d)

1.1.4 Các dòng cuối

tail(d)

1.1.5 Kiểm tra kích thước hàng

nrow(d)

## [1] 999999

1.1.6 Kiểm tra kích cột

length(d)

## [1] 17

1.1.7 Kiểm tra kích thước nhanh

# 999999 quan sát (dòng) 17 biến (cột)
dim(d)

## [1] 999999     17

1.1.8 Kiểm tra cấu trúc kiểu dữ liệu

str(d)

Tên biến	Mô tả	Kiểu dữ liệu
MovieID	Mã định danh duy nhất cho mỗi bộ phim.	Số nguyên (int)
Title	Tên phim được tạo ngẫu nhiên theo ngôn ngữ tự nhiên.	Chuỗi ký tự (chr)
Genre	Thể loại chính của phim (ví dụ: Drama, Action, Comedy, …).	Chuỗi ký tự (chr)
ReleaseYear	Năm phát hành của bộ phim.	Số nguyên (int)
ReleaseDate	Ngày phát hành cụ thể trong năm (định dạng YYYY-MM-DD).	Chuỗi ký tự (chr)
Country	Quốc gia sản xuất hoặc phát hành phim.	Chuỗi ký tự (chr)
BudgetUSD	Ngân sách sản xuất ước tính (USD, từ 100.000 đến 300.000.000).	Số thực (num)
US_BoxOfficeUSD	Doanh thu phòng vé tại thị trường Hoa Kỳ.	Số thực (num)
Global_BoxOfficeUSD	Tổng doanh thu phòng vé toàn cầu.	Số thực (num)
Opening_Day_SalesUSD	Doanh thu bán vé tại Mỹ trong ngày công chiếu đầu tiên.	Số thực (num)
One_Week_SalesUSD	Doanh thu bán vé tại Mỹ trong tuần đầu tiên.	Số thực (num)
IMDbRating	Điểm đánh giá của phim trên nền tảng IMDb (1.0–10.0).	Số thực (num)
RottenTomatoesScore	Điểm đánh giá trên Rotten Tomatoes (0–100%).	Số nguyên (int)
NumVotesIMDb	Số lượt đánh giá phim trên IMDb.	Số nguyên (int)
NumVotesRT	Số lượt đánh giá phim trên Rotten Tomatoes.	Số nguyên (int)
Director	Tên đạo diễn của bộ phim (dữ liệu tổng hợp, không phải tên thật).	Chuỗi ký tự (chr)
LeadActor	Tên diễn viên chính của bộ phim (dữ liệu tổng hợp).	Chuỗi ký tự (chr)

1.1.9 Tóm tắt tổng quan bộ dữ liệu

skim(d)

Data summary
Name	d
Number of rows	999999
Number of columns	17
_______________________
Column type frequency:
character	6
numeric	11
________________________
Group variables	None

Variable type: character

skim_variable	complete_rate	min	max	n_unique
Title	1	1	41	9665
Genre	1	5	11	8
NgayPhatHanh	1	10	10	27757
QuocGia	1	2	11	10
DaoDien	1	9	24	150
DienVienChinh	1	9	21	299

Variable type: numeric

skim_variable	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
IDPhim	1	500000.00	288674.99	1.00	250000.5	500000.0	749999.5	999999	▇▇▇▇▇
NamPhatHanh	1	1998.00	19.26	1950.00	1984.0	2001.0	2014.0	2025	▂▃▅▆▇
KinhPhiUSD	1	9802823.55	22494208.37	100000.00	1190510.8	3265789.5	9002791.0	300000000	▇▁▁▁▁
DT_MyUSD	1	14961631.98	38794034.26	40025.47	1489805.2	4388875.6	12876058.4	1018197889	▇▁▁▁▁
DT_ToanCauUSD	1	27206253.68	69542938.25	100000.00	2762370.0	8090223.4	23552451.2	1499496720	▇▁▁▁▁
DT_NgayDauUSD	1	2992745.17	8132438.35	4050.47	279026.2	838722.1	2510359.5	295751068	▇▁▁▁▁
DT_TuanDauUSD	1	7483442.02	19553372.08	16507.42	738314.5	2179436.3	6415142.6	579555113	▇▁▁▁▁
XepHang	1	6.49	1.49	1.00	5.5	6.5	7.5	10	▁▂▇▇▂
ĐánhGiá	1	64.78	17.59	0.00	53.0	65.0	77.0	100	▁▂▆▇▃
SoBinhChonIMDb	1	9137.18	24922.36	100.00	1083.0	2983.0	8192.0	1000000	▇▁▁▁▁
SoBinhChonRT	1	2031.88	8433.38	50.00	119.0	405.0	1360.0	500000	▇▁▁▁▁

1.1.10 Thống kê cơ bản

#MovieID 
summary(d$IDPhim)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##       1  250001  500000  500000  750000  999999

Biến MovieID có giá trị từ 1 đến 999.999, với trung bình và trung vị đều bằng 500.000, cho thấy các mã được phân bố đều trên toàn bộ dải giá trị. Điều này chứng tỏ đây là biến định danh thuần túy, không mang ý nghĩa thống kê hay kinh tế, chỉ dùng để nhận dạng từng bộ phim trong tập dữ liệu.

#Title
summary(d$Title)

##    Length     Class      Mode 
##    999999 character character

Biến Title có 999.999 giá trị, thuộc kiểu character, cho biết đây là dữ liệu dạng chuỗi ký tự mô tả tên phim. Vì độ dài bằng đúng số quan sát trong tập dữ liệu, có thể thấy mỗi bộ phim đều có một tiêu đề riêng biệt, phản ánh tính duy nhất của từng bản ghi.

#BudgetUSD
summary(d$KinhPhiUSD)

##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
##    100000   1190511   3265790   9802824   9002791 300000000

Biến Kinh Phí USD có giá trị dao động từ 100.000USD đến 300 triệuUSD, với trung bình khoảng 9,8 triệuUSD. Trung vị 3,27 triệuUSD nhỏ hơn nhiều so với giá trị trung bình, cho thấy phân phối lệch phải — tức là phần lớn phim có kinh phí thấp hoặc trung bình, chỉ một số ít phim có ngân sách rất lớn làm tăng giá trị trung bình toàn mẫu.

#ReleaseYear
summary(d$NamPhatHanh)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    1950    1984    2001    1998    2014    2025

Biến Năm Phát Hành có giá trị từ 1950 đến 2025, với trung bình khoảng 1998 và trung vị 2001. Điều này cho thấy dữ liệu bao phủ toàn bộ giai đoạn lịch sử điện ảnh hiện đại, tập trung nhiều hơn vào các phim phát hành từ cuối thế kỷ 20 đến đầu thế kỷ 21, phản ánh xu hướng gia tăng mạnh mẽ số lượng phim trong thời kỳ gần đây.

1.2 Xử lý dữ liệu thô và mã hóa dữ liệu

1.2.1 Kiểm tra giá trị NA

d1 <-colSums(is.na(d))

Không có giá trị NA trong bộ dữ liệu

1.2.2 Kiểm tra và loại bỏ bản ghi trùng lặp

# Đếm số dòng trùng lặp
n_dup <- sum(duplicated(d))
n_dup

## [1] 0

# Loại bỏ bản ghi trùng lặp hoàn toàn
d1 <- d %>% distinct()

1.2.3 Làm sạch các biến

#Loại bỏ ký tự đặt biệt
d1 <- d %>% clean_names()  
names(d)

##  [1] "IDPhim"         "Title"          "Genre"          "NamPhatHanh"   
##  [5] "NgayPhatHanh"   "QuocGia"        "KinhPhiUSD"     "DT_MyUSD"      
##  [9] "DT_ToanCauUSD"  "DT_NgayDauUSD"  "DT_TuanDauUSD"  "XepHang"       
## [13] "ĐánhGiá"        "SoBinhChonIMDb" "SoBinhChonRT"   "DaoDien"       
## [17] "DienVienChinh"

1.2.4 Chuẩn hóa kiểu dữ liệu

d2 <- d1 %>%
  mutate(
    # Chuyển chuỗi ký tự ngày sang kiểu Date theo định dạng ngày/tháng/năm
    ngay_phat_hanh = dmy(ngay_phat_hanh),
    
    # Tạo lại biến năm phát hành từ biến ngày để đảm bảo không bị sai lệch dữ liệu
    nam_phat_hanh = year(ngay_phat_hanh),
    
    # Chuyển các biến định tính sang dạng factor phục vụ phân tích thống kê
    genre = as.factor(genre),
    quoc_gia = as.factor(quoc_gia)
  )

1.2.5 Tạo biến ROI

d2 <- d1 %>%
  mutate(
    ROI = dt_toan_cau_usd / kinh_phi_usd,
    log_budget = log(kinh_phi_usd + 1),
    log_global = log(dt_toan_cau_usd + 1)
  )

Biến ROI Return on Investment được tạo ra nhằm đánh giá hiệu quả tài chính của từng bộ phim. ROI được tính bằng tỷ lệ giữa doanh thu phòng vé toàn cầu và kinh phí sản xuất. Chỉ số này phản ánh mức độ sinh lời, cụ thể cho biết mỗi một đơn vị chi phí đầu tư tạo ra bao nhiêu đơn vị doanh thu. Giá trị ROI càng cao thể hiện bộ phim càng mang lại lợi nhuận tốt so với nguồn vốn bỏ ra. Việc sử dụng ROI giúp so sánh hiệu quả kinh tế giữa các phim có quy mô ngân sách khác nhau, đồng thời hỗ trợ xác định các yếu tố ảnh hưởng đến mức sinh lời, chẳng hạn như thể loại, quốc gia sản xuất hay thời điểm phát hành.

Biến log_budget được tạo ra bằng cách lấy logarit tự nhiên của kinh phí sản xuất cộng một đơn vị. Phép biến đổi log được sử dụng để giảm hiện tượng phân phối lệch phải trong dữ liệu ngân sách, đặc biệt khi một số phim có chi phí rất cao so với phần lớn còn lại. Việc chuẩn hóa này giúp quá trình phân tích và mô hình hóa sau đó trở nên chính xác và ổn định hơn.

Biến log_global được tính tương tự bằng logarit tự nhiên của doanh thu toàn cầu sau khi cộng thêm một đơn vị. Mục tiêu của việc biến đổi này là giảm ảnh hưởng của các giá trị doanh thu quá lớn, đồng thời làm nổi bật mối quan hệ tuyến tính hơn giữa doanh thu và các biến giải thích khác trong mô hình. Điều này hỗ trợ phân tích dữ liệu hiệu quả hơn và cải thiện chất lượng dự báo doanh thu phim.

1.2.6 Loại bỏ phim không có kinh phí

d2 <- d1 %>% filter(!is.na(kinh_phi_usd) & kinh_phi_usd > 0)
nrow(d)

## [1] 999999

1.2.7 Phim chiếu theo quý của các năm

# Thêm biến mới 'release_quarter' dựa trên tháng phát hành
d1 <- d1 %>%
  mutate(release_quarter = case_when(
    month(ngay_phat_hanh) %in% 1:3  ~ "Q1",
    month(ngay_phat_hanh) %in% 4:6  ~ "Q2",
    month(ngay_phat_hanh) %in% 7:9  ~ "Q3",
    month(ngay_phat_hanh) %in% 10:12 ~ "Q4",
    TRUE ~ NA_character_
  ))

1.2.8 Doanh thu Mỹ theo bốn mức độ

quantiles <- quantile(d1$dt_my_usd, probs = c(0.25, 0.5, 0.75), na.rm = TRUE)

d1 <- d1 %>%
  mutate(dt_my_level = case_when(
    dt_my_usd <= quantiles[1] ~ "Thấp",
    dt_my_usd <= quantiles[2] ~ "Trung bình thấp",
    dt_my_usd <= quantiles[3] ~ "Trung bình cao",
    dt_my_usd >  quantiles[3] ~ "Cao",
    TRUE ~ NA_character_
  ))

1.2.9 Thống kê phim chiếu theo quý

sort(table(d1$release_quarter), decreasing = TRUE)

## 
##     Q3     Q4     Q2     Q1 
## 252115 251520 249370 246994

1.2.10 Doanh thu bình ở Mỹ theo Q3

d1 %>%
  filter(release_quarter == "Q3") %>%
  summarise(
    Tong_doanh_thu_Q3 = sum(dt_my_usd, na.rm = TRUE),
    Trung_binh_Q3     = mean(dt_my_usd, na.rm = TRUE),
    So_phim_Q3        = n()
  )

1.3 Các thống kê cơ bản

1.3.1 Biến phụ thuộc Genre

summary(d1$genre)

##    Length     Class      Mode 
##    999999 character character

ts_G <- table(d1$genre)
print(ts_G)

## 
##      Action      Comedy Documentary       Drama      Horror     Romance 
##      150131      199832       50114      250018      100010      100021 
##      Sci-Fi    Thriller 
##       49802      100071

ts_G <- d1 %>%
  count(genre, name = "Tan_so") %>%
  mutate(Tan_suat = round(Tan_so / sum(Tan_so) * 100, 2))

Genre	Tan_so	Tan_suat (%)
Action	150131	17.45
Comedy	199832	23.20
Documentary	50114	5.82
Drama	250018	29.00
Horror	100010	11.61
Romance	100021	11.61
Sci-Fi	49802	5.78
Thriller	100071	11.62

Trong tổng số phim, Drama (29%) và Comedy (23.2%) là hai thể loại phổ biến nhất, chiếm hơn nửa lượng phim trên thị trường. Action đứng thứ ba với 17.45%, trong khi Thriller, Romance và Horror đều chiếm khoảng 11–12%, thể hiện sự đa dạng về nội dung. Các thể loại Documentary và Sci-Fi chiếm tỷ lệ thấp nhất (~5–6%), phản ánh đây là các thể loại hướng đến đối tượng khán giả chuyên biệt. Nhìn chung, thị trường phim tập trung vào các thể loại phổ biến nhưng vẫn duy trì sự đa dạng để đáp ứng nhiều sở thích khác nhau.

library(ggplot2)

ggplot(ts_G, aes(x = genre, y = Tan_so)) +
  geom_col(fill = "#B22222") +  # FireBrick
  geom_text(aes(label = Tan_so),  # chỉ hiển thị số lượng
            vjust = -0.5, color = "black", size = 3.5) +
  labs(
    title = "Tần số phim theo thể loại",
    x = "Thể loại",
    y = "Số lượng phim"
  ) +
  theme_minimal(base_size = 13) +
  theme(
    plot.title = element_text(face = "bold", color = "#8B0000"),
    axis.text.x = element_text(angle = 45, hjust = 1)
  )

1.3.2 Nhóm yếu tố cảm xúc của khán giả

d3 <- d[, c("XepHang", "ĐánhGiá", "SoBinhChonIMDb", "SoBinhChonRT", "Genre")]

1.3.2.1 Genre và DiemIMDb

summary(d3$ĐánhGiá)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    0.00   53.00   65.00   64.78   77.00  100.00

ts_D <- table(d3$ĐánhGiá)
print(ts_D)

## 
##     0     1     2     3     4     5     6     7     8     9    10    11    12 
##   166    42    47    59    63    84   100   133   173   206   221   235   312 
##    13    14    15    16    17    18    19    20    21    22    23    24    25 
##   350   434   502   536   619   757   826   934  1161  1318  1493  1600  1883 
##    26    27    28    29    30    31    32    33    34    35    36    37    38 
##  2190  2461  2744  3024  3398  3751  4148  4520  4968  5602  6083  6786  7367 
##    39    40    41    42    43    44    45    46    47    48    49    50    51 
##  7753  8499  9187  9899 10502 11147 11824 12849 13504 14086 14975 15618 16359 
##    52    53    54    55    56    57    58    59    60    61    62    63    64 
## 17129 17789 18213 19032 19494 19990 20632 20816 21374 21424 21696 21943 22030 
##    65    66    67    68    69    70    71    72    73    74    75    76    77 
## 21932 22279 21931 21873 21828 21297 20998 20683 20032 19677 18826 18230 17879 
##    78    79    80    81    82    83    84    85    86    87    88    89    90 
## 17282 16394 15481 14924 14230 13443 12833 11995 11437 10592  9650  9304  8519 
##    91    92    93    94    95    96    97    98    99   100 
##  7909  7284  6671  6089  5558  5016  4649  4107  3827 26280

ts_D <- d3 %>%
  count(ĐánhGiá, name = "Tan_so") %>%
  mutate(Tan_suat = round(Tan_so / sum(Tan_so) * 100, 2))

# Chia điểm IMDb thành 5 mức
d3$ĐánhGiá <- as.numeric(d3$ĐánhGiá)
d3$ĐánhGiá <- cut(d3$ĐánhGiá ,
                      breaks = c(0, 40, 60, 70, 80, 100),
                      labels = c("Rất thấp", "Thấp", "Trung bình", "Cao", "Rất cao"),
                      include.lowest = TRUE)

# Tính tần số theo thể loại và mức điểm
ts_diem <- table(d1$genre, d3$ĐánhGiá )

Để dễ đánh giá chúng ta chia điểm ra làm 6 mức độ và nhận được kết quả như sau:

# Biểu đồ cột nhóm (so sánh trực quan hơn)
ggplot(d3, aes(x = Genre, fill = ĐánhGiá)) +
  geom_bar(position = position_dodge(width = 0.8)) +  # xếp cột cạnh nhau
  labs(
    title = "So sánh số lượng phim theo thể loại và mức điểm IMDb",
    x = "Thể loại",
    y = "Số lượng phim",
    fill = "Mức điểm"
  ) +
  theme_minimal(base_size = 13) +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1),
    plot.title = element_text(face = "bold")
  ) +
  scale_fill_brewer(palette = "Set2")

#### 1.3.2.2 Genre và IMDbRating

summary(d3$XepHang)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   1.000   5.500   6.500   6.495   7.500  10.000

ts_X <- table(d3$XepHang)
print(ts_X)

## 
##     1   1.1   1.2   1.3   1.4   1.5   1.6   1.7   1.8   1.9     2   2.1   2.2 
##   134    41    63    74    74    98   125   154   188   269   313   363   437 
##   2.3   2.4   2.5   2.6   2.7   2.8   2.9     3   3.1   3.2   3.3   3.4   3.5 
##   511   635   756   887  1066  1245  1485  1727  2029  2303  2818  3172  3547 
##   3.6   3.7   3.8   3.9     4   4.1   4.2   4.3   4.4   4.5   4.6   4.7   4.8 
##  4108  4598  5293  5894  6636  7453  8066  9020 10084 11185 12059 12904 13959 
##   4.9     5   5.1   5.2   5.3   5.4   5.5   5.6   5.7   5.8   5.9     6   6.1 
## 15036 15981 17147 18216 19261 20101 21621 22145 23034 23808 24427 25231 25942 
##   6.2   6.3   6.4   6.5   6.6   6.7   6.8   6.9     7   7.1   7.2   7.3   7.4 
## 25843 26229 26618 26685 26709 26544 26335 25461 25071 24570 24032 23275 22140 
##   7.5   7.6   7.7   7.8   7.9     8   8.1   8.2   8.3   8.4   8.5   8.6   8.7 
## 21159 20311 19354 18237 17412 16230 14623 14057 12727 11934 10987  9926  9133 
##   8.8   8.9     9   9.1   9.2   9.3   9.4   9.5   9.6   9.7   9.8   9.9    10 
##  8179  7336  6809  5936  5345  4598  3968  3600  3202  2674  2350  2027 10650

ts_X <- d3 %>%
  count(XepHang, name = "Tan_so") %>%
  mutate(Tan_suat = round(Tan_so / sum(Tan_so) * 100, 2))

d3$MucXepHang <- cut(as.numeric(d3$XepHang), 3,
                      labels = c("Thấp", "Trung bình", "Cao"),
                      include.lowest = TRUE)

ts_X <- table(d3$MucXepHang)

d3 %>%
  count(MucXepHang) %>%
  mutate(label = paste0(MucXepHang, "\n", round(n / sum(n) * 100, 1), "%")) %>%
  ggplot(aes(x = "", y = n, fill = MucXepHang)) +
  geom_col(color = "white") +
  coord_polar(theta = "y") +
  geom_text(aes(label = label), position = position_stack(vjust = 0.5)) +
  theme_void() +
  scale_fill_brewer(palette = "Set2") +
  labs(title = "Tỷ lệ phim theo mức xếp hạng")

d_plot <- d3 %>%
  mutate(genre = d1$genre) %>%
  count(genre, MucXepHang)

ggplot(d_plot, aes(x = genre, y = n, fill = MucXepHang)) +
  geom_col(position = "dodge") +  # cột cạnh nhau
  geom_text(aes(label = n), position = position_dodge(width = 0.9), vjust = -0.5, size = 3) +
  labs(
    title = "Số lượng phim theo thể loại và mức xếp hạng",
    x = "Thể loại",
    y = "Số lượng phim",
    fill = "Mức xếp hạng"
  ) +
  theme_minimal(base_size = 13) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  scale_fill_brewer(palette = "Set2")

1.3.3 Nhóm yếu tố hình ảnh thương hiệu

d4 <- d[, c("QuocGia", "DaoDien", "DienVienChinh", "Genre")]

1.3.3.1 Director

d4 <- d4 %>%
  mutate(TacGiaSX = case_when(
    Genre == "Drama"        ~ "Tác giả Drama",
    Genre == "Documentary"  ~ "Tác giả Documentary",
    Genre == "Comedy"       ~ "Tác giả Comedy",
    Genre == "Action"       ~ "Tác giả Action",
    TRUE                    ~ "Tác giả Khác"  # các thể loại còn lại
  ))

ts_DD <- table(d4$DaoDien)
print(ts_DD)

## 
##           Abigail Robles               Adam Brown         Adriana Campbell 
##                     6701                     6741                     6748 
##          Albert Phillips             Alyssa Adams          Amanda Cantrell 
##                     6634                     6771                     6546 
##        Amanda Montgomery           Amber Anderson          Andrew Chambers 
##                     6692                     6604                     6750 
##            Anthony Henry          Anthony Rowland            Ashley Medina 
##                     6614                     6758                     6667 
##           Barbara Torres          Benjamin Hudson             Benjamin Ray 
##                     6711                     6698                     6602 
##        Bethany Rodriguez           Brandon Fuller             Brenda Smith 
##                     6615                     6750                     6711 
##           Brian Robinson           Brooke Morales             Bryan Murray 
##                     6818                     6750                     6743 
##           Caitlin Brewer         Carolyn Schwartz            Claudia Smith 
##                     6830                     6722                     6460 
##           Colleen Willis        Courtney Reynolds           Crystal Harris 
##                     6694                     6627                     6675 
##                Chad Koch           Chad Peters MD            Charles Lopez 
##                     6574                     6555                     6514 
##       Charlotte Williams      Christian Hernandez        Christopher Roach 
##                     6654                     6667                     6714 
##             Daniel Brown            Daniel Rivera           Darlene Murphy 
##                     6590                     6625                     6616 
##          Darrell Carlson            David Charles               David Hall 
##                     6616                     6761                     6729 
##                David Lee             David Morris              David Perez 
##                     6637                     6644                     6583 
##            David Rosales             Denise Horne              Diana Davis 
##                     6599                     6658                     6699 
##            Diane Skinner               Donna Hall             Donna Wagner 
##                     6675                     6693                     6602 
##        Dr. Jonathan Long       Dr. Michael Monroe           Elizabeth Lane 
##                     6592                     6585                     6658 
##             Emily Miller             Eric Ramirez           Faith Franklin 
##                     6776                     6708                     6621 
##           Francisco Ford             Gary Simmons           Hannah Camacho 
##                     6779                     6757                     6643 
##           Heidi Cisneros        Jacqueline Briggs              James Cross 
##                     6720                     6615                     6649 
##             James Miller             James Wright            Janice Taylor 
##                     6677                     6606                     6676 
##              Jason Jones         Jeffrey Myers MD             Jeffrey Neal 
##                     6517                     6738                     6674 
##        Jennifer Atkinson           Jennifer Henry          Jennifer Miller 
##                     6597                     6698                     6687 
##          Jennifer Willis             Jeremy Davis               Jeremy Ray 
##                     6721                     6650                     6604 
##              Jerry Owens         Jessica Gonzalez        Jessica Rodriguez 
##                     6494                     6670                     6734 
##            Jessica Singh               John Jones           Jonathan Evans 
##                     6621                     6569                     6712 
##            Jordan Orozco            Joseph Willis             Joshua Baker 
##                     6726                     6677                     6657 
##           Joshua Morales              Judy Walker            Julie Maxwell 
##                     6637                     6658                     6615 
##            Karen Barrett           Karen Robinson              Karen Smith 
##                     6568                     6790                     6689 
##              Kayla Young             Kelsey Ellis              Kevin Green 
##                     6748                     6683                     6591 
##              Kim Watkins          Kimberly Barker           Kristina Moore 
##                     6657                     6470                     6516 
##              Lisa Atkins            Lori Callahan            Manuel Benton 
##                     6708                     6585                     6768 
##               Maria Lane              Mark Brooks               Mark Moody 
##                     6794                     6580                     6716 
##            Mary Mitchell             Matthew Beck              Megan Sharp 
##                     6767                     6633                     6675 
##            Melanie Olson            Melissa Cohen        Melissa Hernandez 
##                     6555                     6576                     6862 
##            Michael Chung          Michael Manning         Michael Richards 
##                     6708                     6759                     6656 
##             Michael Ross         Michelle Collins       Mr. Drew Clark Jr. 
##                     6608                     6699                     6583 
##       Mr. Jorge Anderson Mrs. Hannah Campbell DDS            Nathan Bolton 
##                     6717                     6484                     6620 
##          Nicholas Murphy             Oscar Santos           Patricia Munoz 
##                     6689                     6596                     6706 
##              Paul Rogers               Paul Weiss           Philip Simmons 
##                     6697                     6773                     6729 
##             Rachel Hayes             Rachel Kirby           Raymond Morris 
##                     6794                     6702                     6635 
##           Renee Campbell         Robert Hendricks           Robert Webster 
##                     6694                     6719                     6629 
##        Roberto Underwood             Robin Hooper                Ryan Tate 
##                     6603                     6633                     6715 
##        Samantha Campbell             Sara Higgins              Sean Howard 
##                     6623                     6755                     6748 
##           Seth Whitehead             Shannon Ross            Sharon Wilson 
##                     6569                     6489                     6673 
##              Sonya Clark             Sophia Gomez          Stephanie Hayes 
##                     6674                     6660                     6720 
##             Susan Farley         Suzanne Gonzalez           Tara Underwood 
##                     6759                     6591                     6898 
##           Terry Lawrence            Tyler Sanchez          Thomas Peterson 
##                     6776                     6508                     6672 
##             Tracy Tucker             Troy Cochran              Vanessa Fox 
##                     6614                     6718                     6647 
##            William Banks        William Carpenter           William Walker 
##                     6667                     6646                     6758

ts_DD <- d4 %>%
  count(DaoDien, name = "Tan_so") %>%
  mutate(Tan_suat = round(Tan_so / sum(Tan_so) * 100, 2))

d4_main <- d4 %>%
  filter(TacGiaSX != "Tác giả Khác")  # loại bỏ các hàng còn lại

1.3.3.2 Country

summary(d4$QuocGia)

##    Length     Class      Mode 
##    999999 character character

ts_QG <- table(d4_main$QuocGia)
print(ts_QG)

## 
##   Australia      Canada       China      France     Germany       India 
##       19750       26315       20073       19666       13172       33209 
##       Japan South Korea          UK         USA 
##       13118        6618       33314      464860

ts_QG <- d4_main %>%
  count(QuocGia, name = "Tan_so") %>%
  mutate(Tan_suat = round(Tan_so / sum(Tan_so) * 100, 2))

# Tính tần số và tần suất + tạo nhãn
ts_QG <- d4_main %>%
  count(QuocGia, name = "Tan_so") %>%
  mutate(
    Tan_suat = round(Tan_so / sum(Tan_so) * 100, 2),
    label = paste0(QuocGia, "\n", Tan_suat, "%")
  )

ggplot(ts_QG, aes(x = "", y = Tan_so, fill = QuocGia)) +
  geom_col(color = "white") +
  coord_polar(theta = "y") +
  labs(
    fill = "Quốc gia"
  ) +
  theme_void() +
  theme(
    legend.position = "right"  # Chú thích nằm bên phải biểu đồ
  )

1.3.4 Nhóm yếu tố chi phối

d5 <- d[, c("KinhPhiUSD", "DT_MyUSD", "DT_ToanCauUSD", "DT_NgayDauUSD", "DT_TuanDauUSD", "Genre")]

1.3.4.1 Kinh phí theo thể loại phim

summary(d5$KinhPhiUSD)

##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
##    100000   1190511   3265790   9802824   9002791 300000000

d5_area <- d5 %>%
  group_by(Genre) %>%
  summarise(TongKinhPhi = sum(KinhPhiUSD, na.rm = TRUE)) %>%
  arrange(TongKinhPhi)

ggplot(d5_area, aes(x = Genre, y = TongKinhPhi, group = 1)) +
  geom_area(fill = "#69b3a2", alpha = 0.8) +
  geom_line(size = 1) +
  geom_point(size = 3) +
  theme_minimal() +
  labs(
    title = "Biểu đồ miền: Tổng kinh phí theo thể loại phim",
    x = "Thể loại",
    y = "Tổng kinh phí (USD)"
  ) +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1),
    plot.title = element_text(face = "bold", size = 14, hjust = 0.5)
  )

d5 <- d5 %>%
  mutate(MucKinhPhi = cut(KinhPhiUSD,
                          breaks = quantile(KinhPhiUSD, probs = c(0, 1/3, 2/3, 1), na.rm = TRUE),
                          labels = c( "Thấp", "Trung bình", "Cao"),
                          include.lowest = TRUE))

mm <- d5 %>%
  filter(MucKinhPhi %in% c("Cao", "Trung bình"))

ggplot(mm, aes(x = KinhPhiUSD, y = MucKinhPhi, fill = MucKinhPhi)) +
  geom_density_ridges(alpha = 0.8, color = "black") +
  theme_minimal() +
  labs(
    title = "Phân phối kinh phí theo mức cao và trung bình",
    x = "Kinh phí (USD)",
    y = "Mức kinh phí"
  ) +
  theme(
    legend.position = "none",
    plot.title = element_text(size = 14, face = "bold", hjust = 0.5)
  )

1.3.4.2 Doanh thu ở Mỹ theo thể loại phim

stats_my_genre <- d5 %>%
  group_by(Genre) %>%
  summarise(
    So_phim = n(),
    DoanhThuTB = mean(DT_MyUSD, na.rm = TRUE),
    DoanhThuSD = sd(DT_MyUSD, na.rm = TRUE),
    Min = min(DT_MyUSD, na.rm = TRUE),
    Max = max(DT_MyUSD, na.rm = TRUE)
  )

stats_my_genre

d5 <- d5 %>%
  mutate(
    Muc_DT_My = cut(
      DT_MyUSD,
      breaks = quantile(DT_MyUSD, probs = c(0, 1/3, 2/3, 1), na.rm = TRUE),
      labels = c("Thấp", "Trung bình", "Cao"),
      include.lowest = TRUE
    ))

d5 %>%
  count(Muc_DT_My, Genre) %>%
  ggplot(aes(x = "", y = n, fill = Genre)) +
  geom_col(color = "white") +
  coord_polar("y") +
  facet_wrap(~ Muc_DT_My) +
  theme_void() +
  labs(
    title = "Cơ cấu thể loại phim theo 3 mức Doanh thu tại Mỹ",
    fill = "Thể loại phim"
  )

# Lấy thể loại có số lượng phim nhiều nhất theo từng mức
top_count <- d5 %>%
  count(Muc_DT_My, Genre) %>%
  group_by(Muc_DT_My) %>%
  slice_max(n, n = 1) %>%
  ungroup()

# Vẽ biểu đồ tròn cho 3 mức gộp chung
ggplot(top_count, aes(x = "", y = n, fill = Muc_DT_My)) +
  geom_col(color = "white") +
  coord_polar("y") +
  geom_text(aes(label = paste0(Genre, "\n", n)), 
            position = position_stack(vjust = 0.5),
            size = 4) +
  labs(
    title = "Thể loại phim nhiều nhất theo từng mức doanh thu Mỹ",
    fill = "Mức doanh thu Mỹ"
  ) +
  theme_void(base_size = 12)

1.3.4.3 Doanh thu ở Mỹ theo thể loại phim

CHƯƠNG 2. PHÂN TÍCH DỮ LIỆU BMP

2.1 Giới thiệu dữ liệu

2.1.1 Đọc dữ liệu

library(readxl)
bmp <- read_excel("E:/BMP 14-24.xlsx")

2.1.2 Số dòng số cột dữ liệu

# Số biến dữ liệu (cột)
length(bmp)

## [1] 20

# Số quan sát (dòng)
nrow(bmp)

## [1] 345

2.1.3 Kiểm tra cấu trúc kiểu dữ liệu

str(bmp)

2.1.3 Tóm tắt tổng quan bộ dữ liệu

skim(bmp)

Data summary
Name	bmp
Number of rows	345
Number of columns	20
_______________________
Column type frequency:
character	10
numeric	10
________________________
Group variables	None