BÁO CÁO TIỂU LUẬN MÔN NGÔN NGỮ LẬP TRÌNH TRONG PHÂN TÍCH DỮ LIỆU
Sinh viên thực hiện: Hoàng Trần Hồng Đức — 2321000313
2025-11-8
1 Chương 1: Phân tích dữ liệu tai nạn giao thông Hoa Kỳ năm 2022
1.1 Giới thiệu bộ dữ liệu
1.1.1 Giới thiệu và cấu trúc bộ dữ liệu
Bộ dữ liệu US Accidents (2022) do Sobhan Moosavi (ĐH Ohio State) công bố trên Kaggle, là tập dữ liệu lớn về tai nạn giao thông ở Hoa Kỳ, phục vụ phân tích và dự báo rủi ro. Dữ liệu được thu thập tự động từ hai nguồn:
API và cảm biến: Bing Maps, TomTom, INRIX, Here Traffic… cung cấp thông tin giao thông theo thời gian thực.
Cơ quan giao thông: USDOT, các Sở Giao thông bang và NOAA Weather API cung cấp dữ liệu về thời tiết, vị trí, và mức độ nghiêm trọng tai nạn.
1.1.1.1 Cấu trúc tổng quan bộ dữ liệu
Đọc dữ liệu:
Hàm read_csv() được dùng để đọc tệp dữ liệu định dạng CSV (Comma-Separated Values)
Tổng quan bộ dữ liệu:
## Rows: 1.762.452
## Columns: 17
## $ ID <chr> "A-512230", "A-512231", "A-512232", "A-512…
## $ Source <chr> "Source2", "Source2", "Source2", "Source2"…
## $ Severity <dbl> 1, 1, 1, 1, 2, 1, 2, 2, 1, 1, 1, 3, 1, 1, …
## $ Start_Time <dttm> 2022-09-08 05:49:30, 2022-09-08 02:02:05,…
## $ End_Time <dttm> 2022-09-08 06:34:53, 2022-09-08 04:31:32,…
## $ Start_Lat <dbl> 41,94680, 34,52117, 37,54284, 40,89663, 41…
## $ Start_Lng <dbl> -88,20809, -117,95808, -77,44178, -81,1784…
## $ `Distance(mi)` <dbl> 0,00, 0,00, 0,00, 0,00, 1,91, 1,59, 0,00, …
## $ Street <chr> "Army Trail Rd", "Pearblossom Hwy", "N 2nd…
## $ City <chr> "Bartlett", "Littlerock", "Richmond", "All…
## $ State <chr> "IL", "CA", "VA", "OH", "OH", "PA", "OH", …
## $ Weather_Timestamp <dttm> 2022-09-08 05:52:00, 2022-09-08 01:53:00,…
## $ `Temperature(F)` <dbl> 58, 86, 68, 62, 63, 65, 53, 58, 70, 70, 70…
## $ `Humidity(%)` <dbl> 90, 28, 96, 86, 87, 93, 99, 97, 100, 97, 1…
## $ `Pressure(in)` <dbl> 29,24, 27,35, 29,71, 28,71, 29,37, 29,45, …
## $ `Visibility(mi)` <dbl> 10, 10, 10, 7, 7, 9, 7, 10, 10, 10, 10, 10…
## $ Weather_Condition <chr> "Fair", "Fair", "Mostly Cloudy", "Mostly C…Câu lệnh: Glimpse(US) thực hiện kiểm toán nhanh cấu trúc: in số dòng/cột, kiểu dữ liệu của từng biến và một số giá trị mẫu.
Kết quả: cho thấy bộ dữ liệu bao gồm 1.762.452 bản ghi về các vụ tai nạn giao thông tại Hoa Kỳ, bản ghi này lưu trữ các biến phản ánh đầy đủ ba trục thông tin cốt lõi: thời gian, không gian và thời tiết.
1.1.1.2 Kích thước bộ dữ liệu
## [1] "1.762.452" "17"Câu lệnh: dim(US) trả về kích thước đầy đủ (dòng × cột) của bảng US
Kết quả: cho thấy tập dữ liệu có 1.762.452 bản ghi và 17 biến. Quy mô này rất lớn, đủ mạnh cho phân tích mô tả chi tiết theo không gian-thời gian và điều kiện thời tiết.
1.1.1.3 Tên các biến (liệt kê cột)
## [1] "ID" "Source" "Severity"
## [4] "Start_Time" "End_Time" "Start_Lat"
## [7] "Start_Lng" "Distance(mi)" "Street"
## [10] "City" "State" "Weather_Timestamp"
## [13] "Temperature(F)" "Humidity(%)" "Pressure(in)"
## [16] "Visibility(mi)" "Weather_Condition"colnames(US) Hàm đọc ngay dữ liệu của US và in ra thứ tự tên cột hiện có.
Kết quả: hiển thị 17 tên biến, phản ánh đúng cấu trúc bộ US Accidents:
Nhận diện & nguồn: ID, Source
Định vị không gian: Street, City, State, Start_Lat, Start_Lng
Thời gian: Start_Time, End_Time, Weather_Timestamp (mốc quan trắc thời tiết)
Mức độ sự kiện: Severity (tháng 1-4)
Bối cảnh/đo lường: Distance(mi), Temperature(F), Humidity(%), Pressure(in), Visibility(mi), Weather_Condition
1.1.1.4 Kiểu dữ liệu từng biến
## # A tibble: 17 × 2
## column class
## <chr> <chr>
## 1 ID character
## 2 Source character
## 3 Severity numeric
## 4 Start_Time POSIXct,POSIXt
## 5 End_Time POSIXct,POSIXt
## 6 Start_Lat numeric
## 7 Start_Lng numeric
## 8 Distance(mi) numeric
## 9 Street character
## 10 City character
## 11 State character
## 12 Weather_Timestamp POSIXct,POSIXt
## 13 Temperature(F) numeric
## 14 Humidity(%) numeric
## 15 Pressure(in) numeric
## 16 Visibility(mi) numeric
## 17 Weather_Condition characterCâu lệnh: (1) tạo một bảng gọn, dễ xem, cột thứ nhất chứa tên tất cả các biến của dữ liệu. (2) lặp qua từng cột của US, truyền từng cột vào hàm, trả về kiểu dữ liệu của cột x, nối các lớp đó thành một chuỗi duy nhất, giúp hiển thị đẹp trên một dòng.
Kết quả:
Chuỗi/ký tự (character): ID, Source, Street, City, State, Weather_Condition.
Số (numeric): Severity, Start_Lat, Start_Lng, Distance(mi), Temperature(F), Humidity(%), Pressure(in), Visibility(mi)**.
Ngày-giờ (POSIXct/POSIXt): Start_Time, End_Time, Weather_Timestamp.
1.1.2 Quan sát nhanh bộ dữ liệu
1.1.2.1 Xem nhanh 10 dòng đầu bộ dữ liệu
## # A tibble: 10 × 17
## ID Source Severity Start_Time End_Time
## <chr> <chr> <dbl> <dttm> <dttm>
## 1 A-512230 Source2 1 2022-09-08 05:49:30 2022-09-08 06:34:53
## 2 A-512231 Source2 1 2022-09-08 02:02:05 2022-09-08 04:31:32
## 3 A-512232 Source2 1 2022-09-08 05:14:12 2022-09-08 07:38:17
## 4 A-512233 Source2 1 2022-09-08 06:22:57 2022-09-08 06:52:42
## 5 A-512234 Source2 2 2022-09-08 06:36:20 2022-09-08 07:05:58
## 6 A-512235 Source2 1 2022-09-08 05:10:50 2022-09-08 07:36:00
## 7 A-512236 Source2 2 2022-09-08 06:52:22 2022-09-08 07:21:58
## 8 A-512237 Source2 2 2022-09-08 06:52:22 2022-09-08 07:32:43
## 9 A-512238 Source2 1 2022-09-08 06:10:34 2022-09-08 06:40:17
## 10 A-512239 Source2 1 2022-09-08 06:10:07 2022-09-08 06:39:51
## Start_Lat Start_Lng `Distance(mi)` Street City
## <dbl> <dbl> <dbl> <chr> <chr>
## 1 41.947 -88.208 0 Army Trail Rd Bartlett
## 2 34.521 -117.96 0 Pearblossom Hwy Littlerock
## 3 37.543 -77.442 0 N 2nd St Richmond
## 4 40.897 -81.178 0 Atlantic Blvd NE Alliance
## 5 41.409 -81.644 1.9100 I-77 N Independence
## 6 39.928 -76.805 1.5900 Rolling Meadow Ct York
## 7 39.796 -83.225 0 I-71 Orient
## 8 39.974 -83.012 0 2B Columbus
## 9 33.772 -79.719 0 Five Bridges Rd Lake City
## 10 33.864 -81.238 0 Bluefield Rd Lexington
## State Weather_Timestamp `Temperature(F)` `Humidity(%)`
## <chr> <dttm> <dbl> <dbl>
## 1 IL 2022-09-08 05:52:00 58 90
## 2 CA 2022-09-08 01:53:00 86 28
## 3 VA 2022-09-08 05:16:00 68 96
## 4 OH 2022-09-08 06:51:00 62 86
## 5 OH 2022-09-08 06:53:00 63 87
## 6 PA 2022-09-08 04:53:00 65 93
## 7 OH 2022-09-08 06:50:00 53 99
## 8 OH 2022-09-08 06:51:00 58 97
## 9 SC 2022-09-08 06:15:00 70 100
## 10 SC 2022-09-08 05:56:00 70 97
## `Pressure(in)` `Visibility(mi)` Weather_Condition
## <dbl> <dbl> <chr>
## 1 29.24 10 Fair
## 2 27.35 10 Fair
## 3 29.71 10 Mostly Cloudy
## 4 28.71 7 Mostly Cloudy
## 5 29.37 7 Partly Cloudy
## 6 29.45 9 Cloudy
## 7 29.01 7 Fair
## 8 29.13 10 Fair
## 9 29.75 10 Cloudy
## 10 29.57 10 FairHàm head() trong R được dùng để hiển thị một số dòng đầu tiên của bảng dữ liệu.
Kết quả: Cho thấy dữ liệu được đọc đúng: đủ 17 cột, mỗi dòng tương ứng một vụ tai nạn với vị trí, thời gian, Severity và bối cảnh thời tiết.
1.1.2.2 Xem nhanh 10 dòng cuối bộ dữ liệu
## # A tibble: 10 × 17
## ID Source Severity Start_Time End_Time
## <chr> <chr> <dbl> <dttm> <dttm>
## 1 A-5464707 Source1 2 2022-12-16 17:52:50 2022-12-16 18:05:46
## 2 A-5464708 Source1 2 2022-05-02 14:49:30 2022-05-02 17:00:59
## 3 A-5464709 Source1 2 2022-02-11 17:46:30 2022-02-11 19:51:37
## 4 A-5464710 Source1 2 2022-10-12 21:48:00 2022-10-12 22:20:30
## 5 A-5464711 Source1 2 2022-04-25 13:01:00 2022-04-25 15:04:24
## 6 A-5464714 Source1 2 2022-10-08 13:29:50 2022-10-08 14:44:50
## 7 A-5464715 Source1 2 2022-10-11 05:30:00 2022-10-11 06:47:57
## 8 A-5464716 Source1 2 2022-08-25 09:41:00 2022-08-25 11:00:54
## 9 A-5464717 Source1 2 2022-06-28 14:18:09 2022-06-28 19:29:33
## 10 A-5464718 Source1 2 2022-09-18 08:48:00 2022-09-18 10:30:00
## Start_Lat Start_Lng `Distance(mi)` Street City
## <dbl> <dbl> <dbl> <chr> <chr>
## 1 33.999 -80.960 2.059 I-77 Columbia
## 2 33.609 -117.69 0.182 Muirlands Blvd Mission Viejo
## 3 36.808 -119.81 0.158 W Shaw Ave Fresno
## 4 38.933 -77.257 0.669 VA-267 Vienna
## 5 25.715 -80.414 0.088 SW 56th St Miami
## 6 32.917 -96.718 0.034 Shadow Way Dallas
## 7 33.882 -117.36 0.037 Van Buren Blvd Riverside
## 8 33.882 -117.37 0.012 Van Buren Blvd Riverside
## 9 40.692 -73.551 5.314 Southern Pkwy Merrick
## 10 30.257 -97.612 0.042 N FM 973 Austin
## State Weather_Timestamp `Temperature(F)` `Humidity(%)`
## <chr> <dttm> <dbl> <dbl>
## 1 SC 2022-12-16 17:53:00 52 45
## 2 CA 2022-05-02 14:53:00 71 53
## 3 CA 2022-02-11 17:53:00 71 38
## 4 VA 2022-10-12 21:52:00 65 68
## 5 FL 2022-04-25 12:53:00 83 54
## 6 TX 2022-10-08 14:47:00 75 36
## 7 CA 2022-10-11 05:53:00 64 87
## 8 CA 2022-08-25 09:53:00 83 49
## 9 NY 2022-06-28 13:53:00 75 50
## 10 TX 2022-09-18 08:53:00 75 96
## `Pressure(in)` `Visibility(mi)` Weather_Condition
## <dbl> <dbl> <chr>
## 1 29.75 10 Fair
## 2 29.84 10 Fair
## 3 29.68 8 Fair
## 4 29.68 10 Cloudy
## 5 30.1 10 Fair
## 6 29.61 10 Partly Cloudy
## 7 29.1 5 Cloudy
## 8 29.12 10 Fair
## 9 30.07 10 Mostly Cloudy
## 10 29.45 6 CloudyHàm tail() trong R được dùng để hiển thị một số dòng cuối cùng của bảng dữ liệu
Kết quả: 10 dòng cuối thể hiện các vụ tai nạn gần đây nhất trong bộ dữ liệu, xảy ra từ tháng 6 đến tháng 10 năm 2022.
1.1.2.3 Giới thiệu các biến và giải thích ý nghĩa từng biến
variable_meaning <- data.frame(Variable = c("ID","Source","Severity","Start_Time","End_Time","Start_Lat","Start_Lng", "Distance(mi)","Street","City","State","Weather_Timestamp","Temperature(F)","Humidity(%)", "Pressure(in)","Visibility(mi)","Weather_Condition"),
Meaning = c("Mã định danh duy nhất cho từng vụ tai nạn","Nguồn thu thập dữ liệu","Mức độ nghiêm trọng (1 = nhẹ nhất, 4 = nghiêm trọng nhất)","Thời điểm bắt đầu vụ tai nạn","Thời điểm kết thúc vụ tai nạn","Vĩ độ nơi bắt đầu vụ tai nạn","Kinh độ nơi bắt đầu vụ tai nạn",
"Chiều dài đoạn đường bị ảnh hưởng (dặm)","Tên đường hoặc tuyến","Thành phố nơi tai nạn ghi nhận","Bang/khu vực","Thời điểm thời tiết (timestamp quan trắc/thời điểm sự kiện)","Nhiệt độ (°F) tại thời điểm tai nạn","Độ ẩm (%) tại thời điểm tai nạn","Áp suất khí quyển (inch Hg)","Tầm nhìn (mile)", "Điều kiện thời tiết quan sát"),
stringsAsFactors = FALSE,check.names = FALSE)
data_types <- data.frame(Variable = names(US),DataType = vapply(US, function(x) paste(class(x), collapse = "|"), character(1L)),
stringsAsFactors = FALSE)
variable_summary <- left_join(variable_meaning, data_types, by = "Variable")
library(kableExtra)
kbl(variable_summary,
format="latex", booktabs=TRUE, longtable=TRUE,
caption="Tên biến, ý nghĩa và kiểu dữ liệu",
align="llll", escape=TRUE) |>
kable_styling(latex_options=c("repeat_header","hold_position"), font_size=10) |>
column_spec(1, width="3.2cm") |>
column_spec(2, width="9.6cm") |>
column_spec(3, width="3.2cm")Câu lệnh: (1) Tạo bảng variable_meaning gồm 2 cột: tên biến và ý nghĩa tiếng Việt; (2) Không đổi kiểu factor, giữ nguyên tên cột; (3) Tạo bảng data_types: liệt kê tên biến của US và kiểu dữ liệu (ghép nhiều lớp bằng “|”); (4) Không dùng factor cho bảng kiểu dữ liệu; (5) Gộp hai bảng theo cột “Variable” → bảng tổng hợp variable_summary; (6) Nạp thư viện kableExtra để xuất bảng đẹp; (7) Tạo bảng LaTeX với kbl(): bật booktabs, longtable, đặt caption và căn lề cột; (8) Giữ nguyên ký tự đặc biệt (escape = TRUE).
Nhận xét:
ID: Mã định danh duy nhất cho mỗi vụ tai nạn, giúp phát hiện trùng lặp và đảm bảo dữ liệu độc lập.
Source: Nguồn thu thập (API, cảm biến…), phục vụ đánh giá độ tin cậy và độ phủ dữ liệu.
Severity: Mức nghiêm trọng 1–4, phản ánh độ nặng nhẹ của tai nạn.
Start_Time / End_Time: Thời điểm bắt đầu và kết thúc, định dạng POSIXct; dùng để phân tích chu kỳ, thời gian ảnh hưởng.
Start_Lat / Start_Lng: Vĩ độ và kinh độ (độ thập phân), phục vụ định vị và lập bản đồ.
Distance(mi): Chiều dài đoạn đường bị ảnh hưởng (dặm).
Street / City / State: Vị trí xảy ra tai nạn (đường, thành phố, bang), dạng ký tự.
Weather_Timestamp: Thời điểm quan trắc thời tiết để đối chiếu với thời gian tai nạn.
Temperature(F), Humidity(%), Pressure(in), Visibility(mi): Các biến thời tiết đo bằng °F, %, inHg, dặm; ảnh hưởng trực tiếp đến rủi ro tai nạn.
Weather_Condition: Mô tả thời tiết như mưa, sương mù, tuyết…
1.1.2.4 Đếm số biến theo loại (numeric/ character/ thời gian)
## classes
## character numeric POSIXct
## 6 8 3Câu lệnh: (1) lặp qua từng cột của data frame US, trả về vector lớp của cột x, lấy lớp đầu tiên để gọn. (2) đếm tần suất mỗi lớp xuất hiện trong classes.
Kết quả: bộ dữ liệu có đúng 17 cột của bộ dữ liệu:8 biến numeric, 3 biến thời gian POSIXct), 6 biến character.
1.1.3 Kiểm tra chất lượng và tính hợp lệ
1.1.3.1 Kiểm tra cột thời gian và múi giờ
## [1] "Kiểu của Start_Time là POSIXct? TRUE"## [1] "Múi giờ của Start_Time: UTC"## [1] "Kiểu của End_Time là POSIXct? TRUE"## [1] "Múi giờ của End_Time: UTC"Câu lệnh: Kiểm tra cột Start_Time và End_Time có thuộc lớp POSIXct không. paste(…) ghép chuỗi mô tả với kết quả TRUE/FALSE. tz(x) trả về múi giờ gắn với vector thời gian x (dựa trên thuộc tính tzone).
Kết quả: cho thấy cả Start_Time và End_Time đều là POSIXct/POSIXt và có múi giờ “UTC”. Điều này chứng tỏ dữ liệu đã được parse đúng và nhất quán về múi giờ.
1.1.3.2 Kiểm tra phạm vi thời gian ghi nhận
## [1] "Phạm vi của Start_Time:"## [1] "2022-01-01 00:02:00 UTC"## [1] "2022-12-31 23:59:03 UTC"## [1] "Phạm vi của End_Time:"## [1] "2022-01-01 00:31:30 UTC"## [1] "2023-03-31 23:59:00 UTC"Câu lệnh: min, max lấy thời điểm sớm nhất (giá trị nhỏ nhất) của Start_Time và End_Time. na.rm = TRUE yêu cầu bỏ qua NA khi tính, nếu không có thể trả NA. (3) (6) lấy thời điểm muộn nhất (giá trị lớn nhất) của Start_Time và End_Time.
Kết quả:
Phạm vi của Start_Time trải từ 2022-01-01 00:02:00 UTC đến 2022-12-31 23:59:03 UTC => dữ liệu khởi phát sự kiện phủ trọn năm 2022.
Phạm vi của End_Time trải từ 2022-01-01 00:31:30 UTC đến 2023-03-31 23:59:00 UTC => có một số vụ kết thúc sau 2022, có thể do sự cố kéo dài/ghi nhận muộn.
1.1.3.3 Kiểm tra giá bị trị bị trùng lặp
## # A tibble: 0 × 18
## # ℹ 18 variables: ID <chr>, Source <chr>, Severity <dbl>, Start_Time <dttm>, End_Time <dttm>, Start_Lat <dbl>, Start_Lng <dbl>, Distance(mi) <dbl>, Street <chr>, City <chr>, State <chr>, Weather_Timestamp <dttm>, Temperature(F) <dbl>, Humidity(%) <dbl>, Pressure(in) <dbl>, Visibility(mi) <dbl>, Weather_Condition <chr>, dupe_count <int>Câu lệnh: get_dupes: Lọc ra các dòng bị trùng trong dữ liệu trên toàn bộ cột.
Kết quả: trả ra A tibble: 0 × 18 không có hàng nào trùng hoàn toàn.Số cột là 18 vì: 17 cột gốc + 1 cột dupe_count(số lần trùng trong nhóm) => Đây là tín hiệu tốt cho độ tin cậy của phần mô tả.
1.1.3.4 Kiểm tra giá trị bị thiếu
na_tbl <- map_dbl(US, ~sum(is.na(.))) |> enframe(name = "Cột", value = "Số_NA") |>
arrange(desc(Số_NA)) |> mutate(`Số NA` = format(Số_NA, big.mark=".", decimal.mark=",", trim=TRUE)) |> select(Cột, `Số NA`)
print(na_tbl, n = Inf)## # A tibble: 17 × 2
## Cột `Số NA`
## <chr> <chr>
## 1 Visibility(mi) 41.953
## 2 Humidity(%) 41.107
## 3 Temperature(F) 38.718
## 4 Weather_Condition 38.688
## 5 Pressure(in) 33.134
## 6 Weather_Timestamp 29.595
## 7 Street 7.236
## 8 City 65
## 9 ID 0
## 10 Source 0
## 11 Severity 0
## 12 Start_Time 0
## 13 End_Time 0
## 14 Start_Lat 0
## 15 Start_Lng 0
## 16 Distance(mi) 0
## 17 State 0Câu lệnh: (1) Đếm số NA của từng cột trong US → bảng hai cột Cột & Số_NA; (2) Sắp giảm dần theo Số_NA, định dạng số (ngăn nghìn “.”, thập phân “,”), rồi chỉ giữ 2 cột; (3) In toàn bộ bảng (không giới hạn số dòng).
Nhận xét:
City thiếu 65 giá trị (nhỏ).
Street, Temperature(F), Humidity(%), Pressure(in), Visibility(mi), Weather_Condition thiếu rất lớn: 7.236, 38.718, 41.107, 33.134, 41.953, 38.688 dòng.
ID, Source, Severity, Start_Time, End_Time, Start_Lat, Start_Lng, State không thiếu giá trị.
Nguyên nhân:
Street/City: Tai nạn trên cao tốc/nút giao/đường không tên, khác biệt quy ước ký tự giữa nguồn, lỗi chuẩn hóa → gán NA.
Nhóm thời tiết: Dữ liệu theo không-thời gian từ trạm gần nhất; vùng thưa trạm, lệch “cửa sổ” ghép, hoặc gián đoạn đo (bảo trì, mất điện, bão tuyết/giông) → bỏ trống đúng lúc thời tiết khắc nghiệt.
1.2 Xử lý dữ liệu thô và mã hóa dữ liệu
1.2.1 Loại bỏ biến không cần thiết
Câu lệnh: Câu lệnh US <- US %>% dplyr::select(-Weather_Timestamp) dùng dplyr để cập nhật lại bảng dữ liệu, loại bỏ hoàn toàn cột Weather_Timestamp và giữ nguyên các cột còn lại.
Biến Weather_Timestamp thể hiện thời điểm ghi nhận thời tiết gần lúc xảy ra tai nạn, nhưng thông tin này trùng với Start_Time vì hai thời điểm thường trùng hoặc rất gần nhau. Vì vậy, Weather_Timestamp được loại bỏ để tránh trùng lặp thông tin và giúp mô hình gọn nhẹ, hiệu quả hơn.
1.2.2 Xử lý biến NA
1.2.2.1 Kiểm tra độ lệch phân phối các biến NA
Kiểm tra độ lệch phân phối các biến NA với hai chỉ số chuẩn là skewness (độ lệch trái/phải) và kurtosis (độ nặng đuôi). Nếu phân phối gần chuẩn (skew≈0, kurtosis≈0) thì có thể điền mean; nếu lệch mạnh/đuôi nặng thì nên ưu tiên median, biến đổi log, hoặc điền theo nhóm.
vars <- c("Temperature(F)", "Humidity(%)", "Pressure(in)", "Visibility(mi)", "Distance(mi)")
skew_tab <- sapply(US[vars], function(x) e1071::skewness(x, na.rm = TRUE))
kurt_tab <- sapply(US[vars], function(x) e1071::kurtosis(x, na.rm = TRUE))
data.frame(variable = vars, skewness = skew_tab, kurtosis = kurt_tab)## variable skewness kurtosis
## Temperature(F) Temperature(F) -0,7144853 0,2535267
## Humidity(%) Humidity(%) -0,2617628 -0,8195426
## Pressure(in) Pressure(in) -3,1474550 18,4552088
## Visibility(mi) Visibility(mi) -0,6891490 45,1934911
## Distance(mi) Distance(mi) 12,9725146 696,3156995Câu lệnh: (1) tạo vector tên các biến cần tính. (2) duyệt từng cột trong US[vars] và tính độ lệch (skewness), bỏ giá trị thiếu. (3) tương tự, tính độ nhọn (kurtosis) cho từng cột. (4) gộp kết quả thành bảng cuối.
Nhận xét:
Temperature có skewness ≈ −0,71 và kurtosis ≈ 0,25 → phân phối hơi lệch trái nhưng gần chuẩn, nên điền giá trị trung bình (mean) để giữ nguyên kỳ vọng và không làm méo phân phối.
Humidity có skewness ≈ −0,26 và kurtosis ≈ −0,82 → gần đối xứng nhưng bị chặn [0–100], dễ dồn cụm ở 100%, nên điền giá trị trung vị (median) phản ánh trung tâm thực tế hơn.
Pressure tập trung quanh 29–30 inHg, có một số ngoại lai kỹ thuật (0 hoặc ~58,6 inHg), đuôi nặng → điền giá trị trung vị (median) để giảm ảnh hưởng điểm cực trị.
Visibility bị giới hạn ở 10 miles, nhiều điểm trần = 10, phần còn lại 0–3 miles → skew âm, kurtosis cao → điền giá trị trung vị (median) hợp lý hơn mean.
1.2.2.2 Xử lý giá trị thiếu NA
get_mode <- function(x) {x_no_na <- x[!is.na(x)]
if (length(x_no_na) > 0) {counts <- table(x_no_na)
names(counts)[which.max(counts)] } else {NA_character_ }}
cols_for_mean <- c("Temperature(F)")
cols_for_median <- c("Humidity(%)", "Pressure(in)", "Visibility(mi)", "Distance(mi)")
cols_for_mode <- c("City", "Street", "Weather_Condition")
US <- US %>%mutate(
across(all_of(cols_for_mean),~ replace_na(., mean(., na.rm = TRUE))),
across(all_of(cols_for_median),~ replace_na(., median(., na.rm = TRUE))),
across(all_of(cols_for_mode),~ replace_na(., get_mode(.))))Câu lệnh: (1) Viết hàm tính mode. (4) (5) (6) Chia cột theo cách điền khuyết: cột số dùng mean, median; cột phân loại dùng mode. (7) Cập nhật dữ liệu US bằng các phép biến đổi bên trong mutate.
Nhận xét:
Biến Temperature(F) được điền khuyết bằng trung bình (mean) để bảo toàn kỳ vọng và giữ nguyên cỡ mẫu cho các thống kê, biểu đồ theo thời gian – không gian. Các biến định lượng khác có NA được điền bằng trung vị (median), vì phần lớn phân phối bị lệch, đuôi nặng hoặc trần (như Visibility(mi), Distance(mi), Pressure(in)). Trung vị ít bị ảnh hưởng bởi ngoại lai và phản ánh trung tâm thực hơn.
Các biến định tính dạng chuỗi (Street, City, Weather_Condition…) có tỷ lệ thiếu nhỏ, được điền bằng giá trị mode – cách đơn giản, thống nhất và không làm sai lệch phân bố danh mục.
1.2.2.3 Kiểm tra lại xem còn giá trị NA
## ID Source Severity
## 0 0 0
## Start_Time End_Time Start_Lat
## 0 0 0
## Start_Lng Distance(mi) Street
## 0 0 0
## City State Temperature(F)
## 0 0 0
## Humidity(%) Pressure(in) Visibility(mi)
## 0 0 0
## Weather_Condition
## 0Câu lệnh: colSums(is.na(US)): đếm số NA của từng cột trong US.
Kết quả: Sau khi xử lý giá trị thiếu NA của các biến thì kết quả kiểm tra lại là 0.
1.2.3 Phân loại những cột cần thiết
1.2.3.1 Phân loại ngày tháng năm xảy ra tai nạn
Tạo thêm một biến Date giúp nhóm - tổng hợp nhanh, tránh phải xử lý trên đối tượng ngày-giờ phức tạp và giảm rủi ro sai lệch múi giờ khi so sánh.
Câu lệnh: mutate(Date = …) tạo cột mới tên Date; as.Date(Start_Time) trích phần ngày từ Start_Time (đã ở POSIXct), bỏ phần giờ-phút-giây và trả về kiểu Date (YYYY-MM-DD).
1.2.3.2 Thêm cột chênh lệch thời gian xảy sau khi kết thúc tai nạn
Việc tạo biến này giúp phản ánh mức độ kéo dài của mỗi sự kiện, từ đó hỗ trợ phân tích mức độ nghiêm trọng, khả năng ứng phó cũng như hiệu quả xử lý trong từng trường hợp tai nạn.
Câu lệnh: (1) thêm một cột mới vào dữ liệu US; (2) tính khoảng thời gian giữa End_Time và Start_Time với đơn vị phút.
1.2.3.3 Thêm cột giờ bắt đầu xảy ra tai nạn
Trích giờ trong ngày từ thời điểm Start_Time để phân tích mẫu hình theo khung giờ (giờ cao điểm - thấp điểm, phân bổ tai nạn theo 0-23h).
Câu lệnh: hour(Start_Time) hàm của lubridate lấy giá trị giờ (0-23) từ cột thời gian Start_Time.
1.2.3.4 Thêm cột tháng xảy ra tai nạn
Trích tháng xảy ra tai nạn từ Start_Time để phân tích tính mùa vụ (mưa/bão, lễ Tết…), so sánh tần suất theo 12 tháng, và làm biến nhóm cho thống kê/biểu đồ hoặc mô hình.
Câu lệnh: month(Start_Time) (lubridate) lấy tháng (1-12) từ cột thời gian Start_Time.
1.2.3.5 Phân loại hướng đi từ Street
Việc phân loại này giúp phục vụ cho các phân tích chuyên sâu hơn về phân bố tai nạn theo hướng lưu thông, hỗ trợ phát hiện các khu vực hoặc tuyến đường có rủi ro cao theo hướng di chuyển cụ thể.
US <- US %>% mutate(
Direction = case_when(
str_detect(Street, regex("\\bN\\b|\\bNB\\b|North", ignore_case = TRUE)) ~ "North (Bắc)",
str_detect(Street, regex("\\bS\\b|\\bSB\\b|South", ignore_case = TRUE)) ~ "South (Nam)",
str_detect(Street, regex("\\bE\\b|\\bEB\\b|East", ignore_case = TRUE)) ~ "East (Đông)",
str_detect(Street, regex("\\bW\\b|\\bWB\\b|West", ignore_case = TRUE)) ~ "West (Tây)",
TRUE ~ "Không rõ/Khác" ))Câu lệnh: str_detect() thuộc gói stringr, được dùng để tìm kiếm các chuỗi con trong biến Street, xác định xem tên đường có chứa từ khóa chỉ hướng như “North”, “South”, “East”, “West” hay không; regex(…, ignore_case = TRUE) cho phép tìm kiếm không phân biệt chữ hoa hay chữ thường, đồng thời sử dụng biểu thức chính quy (regex) để bắt nhiều trường hợp viết tắt như “N”, “NB”, “SB”, v.v.
1.2.3.6 Phân loại mùa xảy ra tai nạn theo mùa
Việc phân chia này giúp nhận diện xu hướng thời tiết và điều kiện môi trường ảnh hưởng đến xác suất xảy ra tai nạn, đồng thời hỗ trợ đánh giá sự khác biệt giữa các mùa trong năm.
US <- US %>% mutate( Season = case_when(
Start_Month %in% c(3, 4, 5) ~ "Mùa Xuân",
Start_Month %in% c(6, 7, 8) ~ "Mùa Hè",
Start_Month %in% c(9, 10, 11) ~ "Mùa Thu",
Start_Month %in% c(12, 1, 2) ~ "Mùa Đông",
TRUE ~ "Khác"))Câu lệnh: case_when() giúp gán giá trị mùa tương ứng dựa trên tháng trong biến Start_Month; Toán tử %in% kiểm tra xem giá trị tháng có thuộc vào nhóm tháng đặc trưng của từng mùa hay không
1.2.3.7 Phân loại đường
Phân loại các vụ tai nạn theo loại hình đường, từ đó đánh giá được mức độ rủi ro và tần suất xảy ra tai nạn trên từng loại tuyến giao thông khác nhau.
US <- US %>%mutate(
Road_Type = case_when(
str_detect(Street, regex("I-|Interstate", ignore_case=TRUE)) ~ "Cao tốc",
str_detect(Street, regex("Hwy|Highway|US-", ignore_case=TRUE)) ~ "Quốc lộ",
str_detect(Street, regex("St|Street|Ave|Blvd|Rd", ignore_case=TRUE)) ~ "Đường nội bộ",
TRUE ~ "Khác"))Câu lệnh: str_detect() thuộc gói stringr, giúp tìm kiếm chuỗi ký tự trong tên đường (Street) để xác định loại tuyến giao thông; regex(…, ignore_case = TRUE) cho phép tìm kiếm không phân biệt chữ hoa - chữ thường, đồng thời linh hoạt nhận diện nhiều kiểu viết tắt (ví dụ: “Hwy”, “Blvd”, “Rd”).
1.2.3.8 Phân loại vùng địa lý
Việc bổ sung biến này giúp đánh giá xu hướng tai nạn theo từng khu vực, hỗ trợ việc so sánh mức độ rủi ro và tần suất xảy ra tai nạn trong các vùng có điều kiện địa lý, khí hậu và hạ tầng giao thông khác nhau.
US <- US %>%mutate(Region = case_when(State %in% c("CA", "OR", "WA", "NV", "AZ") ~ "Miền Tây (West)",
State %in% c("IL", "OH", "MI", "MN", "WI") ~ "Miền Trung Tây (Midwest)",
State %in% c("NY", "PA", "NJ", "MA", "CT") ~ "Miền Đông Bắc (Northeast)",
State %in% c("TX", "FL", "GA", "NC", "SC", "VA") ~ "Miền Nam (South)",TRUE ~ "Vùng khác"))Câu lệnh: mutate() được dùng để tạo thêm biến mới Region trong bảng dữ liệu US; case_when() giúp gán nhãn vùng địa lý dựa trên mã bang (State) của từng bản ghi.
1.2.3.9 Phân loại theo thời lượng
Việc chia khoảng này giúp dễ dàng quan sát tần suất phân bố của các vụ tai nạn theo mức độ ngắn, trung bình hoặc kéo dài.
cuts <- c(0, 30, 45, 60, 75, 90, 105, Inf)
labs <- c("≤30", "31-45", "46-60", "61-75", "76-90", "91-105", ">105")
US <- US %>% mutate(Duration_Bin = cut(Duration_Minutes,
breaks = cuts, labels = labs,
include.lowest = TRUE, right = TRUE, ordered_result = TRUE))Câu lệnh: (1) xác định các điểm ngắt (breakpoints) để chia dữ liệu thành các khoảng thời lượng, ví dụ: ≤30 phút, 31-45 phút, 46-60 phút,…;(2) gán nhãn mô tả cho từng khoảng tương ứng, giúp kết quả dễ đọc và diễn giải hơn; (3) được dùng để thêm biến mới Duration_Bin vào bộ dữ liệu US, chia dữ liệu liên tục thành các nhóm khoảng giá trị.
1.3 Các thống kê cơ bản về bộ dữ liệu
1.3.1 Thống kê mô tả biến định tính
1.3.1.1 Xác định biến định tính
## [1] "ID" "Source" "Street"
## [4] "City" "State" "Weather_Condition"
## [7] "Direction" "Season" "Road_Type"
## [10] "Region" "Duration_Bin"Câu lệnh: (1) Duyệt từng cột của data frame US và kiểm tra, lấy tên các cột có giá trị TRUE ở bước trên ⇒ thu được danh sách tên biến phân loại. (2) Gán kết quả vào cat_vars (vector ký tự các tên cột phân loại) và in ra để xem.
Kết quả: Đoạn lệnh đã nhận diện 11 biến phân loại: ID, Source, Street, City, State, Weather_Condition, Direction, Season, Road_Type, Region, Duration_Bin. Trong đó có 4 biến dẫn xuất vừa tạo để phân tích: Direction, Season, Road_Type, Region; và 1 biến rời rạc hóa: Duration_Bin.
1.3.1.2 Thống kê giá trị xuất hiện nhiều nhất của mỗi dữ liệu biến định tính
freq_all <- US %>%
select(where(~ is.character(.x) || is.factor(.x)), -ID, -Source) %>%pivot_longer(everything(), names_to = "Bien", values_to = "Gia_tri") %>%
count(Bien, Gia_tri, sort = TRUE) %>%group_by(Bien) %>%
mutate(Ty_le_phan_tram = 100 * n / sum(n)) %>%
ungroup()
mode_tbl_final <- freq_all %>%group_by(Bien) %>%
slice_max(n, n = 1, with_ties = FALSE) %>%
ungroup() %>%select(Bien,Gia_tri_pho_bien = Gia_tri,So_lan = n,Ty_le_phan_tram)
mode_tbl_vn_num <- mode_tbl_final %>%
rename(`Biến` = Bien, `Giá trị phổ biến` = Gia_tri_pho_bien,`Số lần` = So_lan,`Tỷ lệ (%)` = Ty_le_phan_tram)
mode_tbl_vn_show <- mode_tbl_vn_num %>%
mutate(`Số lần` = format(`Số lần`, big.mark = ".", decimal.mark = ",", trim = TRUE),`Tỷ lệ (%)` = paste0(format(`Tỷ lệ (%)`, big.mark = ".", decimal.mark = ",", digits = 2, trim = TRUE),"%"))
mode_tbl_vn_show## # A tibble: 9 × 4
## Biến `Giá trị phổ biến` `Số lần` `Tỷ lệ (%)`
## <chr> <chr> <chr> <chr>
## 1 City Miami 64.609 3,7%
## 2 Direction Không rõ/Khác 949.747 53,9%
## 3 Duration_Bin >105 659.712 37,4%
## 4 Region Miền Nam (South) 648.115 36,8%
## 5 Road_Type Đường nội bộ 670.536 38,0%
## 6 Season Mùa Xuân 496.398 28,2%
## 7 State CA 375.913 21,3%
## 8 Street I-95 S 23.999 1,4%
## 9 Weather_Condition Fair 904.354 51,3%Câu lệnh: (1) lấy các cột định tính; (2) chuyển về dạng dài với 2 cột: Bien (tên biến) và Gia_tri (giá trị); (3) Đếm tần suất & tỷ lệ trong từng biến. (10) Đổi tên cột sang tiếng Việt
Nhận xét:
Direction có hơn 53% “Không rõ/Khác”, cho thấy biến hướng đi thiếu/không chuẩn hóa; khi phân tích nên loại bỏ hoặc gom thành nhóm riêng để tránh lệch kết quả. Weather_Condition = Fair chiếm 51,31%, nghĩa là đa số tai nạn xảy ra trong thời tiết bình thường; thời tiết không phải lúc nào cũng là tác nhân chính.
Road_Type = Đường nội bộ (38,05%) và Region = Miền Nam (36,77%) cho thấy tai nạn tập trung ở đô thị miền Nam—khu vực có mật độ giao thông cao. Duration_Bin > 105 phút (37,43%) cho thấy nhiều vụ kéo dài trên 1,5 giờ, hàm ý sự cố quy mô lớn hoặc xử lý khó.
Các tín hiệu khác như Season = Mùa Xuân (28,17%) và State = CA (21,33%) phản ánh tập trung ở mùa/địa bàn lưu lượng lớn.
1.3.1.3 Thống kê tần suất của 10 bang (State) xảy ra nhiều tai nạn nhất
top10_bang_num <- US %>%count(State, name = "So_vu") %>%
mutate(Ty_le = round(100 * So_vu / sum(So_vu), 2)) %>%
arrange(desc(So_vu)) %>%slice_head(n = 10) %>%
rename(Bang = State,`Số vụ` = So_vu,`Tỷ lệ (%)` = Ty_le)
top10_bang_show <- top10_bang_num %>%
mutate(`Số vụ` = format(`Số vụ`, big.mark = ".", decimal.mark = ",", trim = TRUE),
`Tỷ lệ (%)` = paste0(format(`Tỷ lệ (%)`, decimal.mark = ",", trim = TRUE), "%"))
top10_bang_show ## # A tibble: 10 × 3
## Bang `Số vụ` `Tỷ lệ (%)`
## <chr> <chr> <chr>
## 1 CA 375.913 21,33%
## 2 FL 263.119 14,93%
## 3 VA 99.311 5,63%
## 4 TX 95.509 5,42%
## 5 NY 94.765 5,38%
## 6 SC 84.880 4,82%
## 7 PA 80.839 4,59%
## 8 NC 72.167 4,09%
## 9 NJ 42.244 2,40%
## 10 AZ 39.423 2,24%Câu lệnh: (1) gom theo State và đếm số bản ghi, đặt tên cột đếm là n.(2) tính tỷ lệ % của từng bang trên toàn bộ dữ liệu. (3) sắp xếp giảm dần theo số vụ để xếp hạng.
Nhận xét: Top 10 bang có số vụ tai nạn cao nhất chiếm 70,83% tổng số vụ, trong đó California (21,33%) và Florida (14,93%) vượt trội so với phần còn lại (khoảng 5–6% mỗi bang). Điều này cho thấy phân bố tai nạn rất tập trung ở các bang đông dân, đô thị hóa cao và có lưu lượng giao thông lớn. Nguyên nhân chính đến từ mật độ phương tiện, quy mô dân số, cấu trúc hạ tầng và hành vi lái xe đô thị.
1.3.1.4 Thống kê tần suất của số vụ tai nạn theo từng nguồn
src_num <- US %>%count(Source, name = "So_ban_ghi") %>%
mutate(Ty_le = 100 * So_ban_ghi / sum(So_ban_ghi)) %>% # %
arrange(desc(So_ban_ghi)) %>%
rename(`Nguồn` = Source,`Số bản ghi` = So_ban_ghi,`Tỷ lệ (%)` = Ty_le )
src_show <- src_num %>%mutate(`Số bản ghi` = format(`Số bản ghi`, big.mark=".", decimal.mark=",", trim=TRUE), `Tỷ lệ (%)` = percent(`Tỷ lệ (%)`/100, accuracy=0.01, decimal.mark=","))
src_show## # A tibble: 3 × 3
## Nguồn `Số bản ghi` `Tỷ lệ (%)`
## <chr> <chr> <chr>
## 1 Source1 1.526.270 86,60%
## 2 Source2 219.411 12,45%
## 3 Source3 16.771 0,95%Câu lệnh: (1) đếm số dòng theo từng nguồn Source. (2) tính tỷ lệ % của từng nguồn trên tổng số bản ghi
Nhận xét: Dữ liệu tai nạn giao thông tập trung chủ yếu ở Source1 (86,6%), trong khi Source2 chỉ chiếm 12,4% và Source3 vỏn vẹn 1,0%. Sự lệch áp đảo của Source1 phản ánh khả năng thiên lệch trong thu thập dữ liệu, do khác biệt về phạm vi, tần suất hoặc phương pháp ghi nhận giữa các nguồn.
1.3.1.5 Thống kê tần suất của mùa (Season) xảy ra nhiều tai nạn nhất
season_summary_num <- US %>%count(Season, name = "So_vu") %>%
mutate(Ty_le = 100 * So_vu / sum(So_vu)) %>%
arrange(desc(So_vu)) %>%
rename(`Mùa` = Season,`Số vụ` = So_vu,`Tỷ lệ (%)` = Ty_le)
season_summary_show <- season_summary_num %>%
mutate(`Số vụ`= format(`Số vụ`, big.mark=".", decimal.mark=",", trim=TRUE),`Tỷ lệ (%)` = percent(`Tỷ lệ (%)`/100, accuracy=0.01, decimal.mark=","))
season_summary_show## # A tibble: 4 × 3
## Mùa `Số vụ` `Tỷ lệ (%)`
## <chr> <chr> <chr>
## 1 Mùa Xuân 496.398 28,17%
## 2 Mùa Đông 488.647 27,73%
## 3 Mùa Hè 422.297 23,96%
## 4 Mùa Thu 355.110 20,15%Câu lệnh: (1) đếm số vụ theo từng mùa; (2) tính tỷ lệ % mỗi mùa trên tổng số vụ; (3) sắp xếp mùa theo số vụ giảm dần; (4) đổi tên cột sang tiếng Việt.
Nhận xét: Phân bố theo mùa cho thấy mùa Xuân (28,17%) và mùa Đông (27,73%) chiếm hơn 55% tổng số vụ tai nạn, cao hơn rõ so với mùa Hè (23,96%) và mùa Thu (20,15%). Chênh lệch khoảng 8 điểm % giữa mùa cao nhất và thấp nhất cho thấy hiệu ứng mùa vụ rõ rệt. Xuân và Đông thường có mưa, sương mù, tuyết, ánh sáng yếu, trong khi Hè–Thu ổn định hơn nhưng Hè có thể bị ảnh hưởng bởi nắng nóng, mệt mỏi.
1.3.1.6 Thống kê tần suất của số vụ tai nạn theo loại đường
road_type_summary_num <- US %>%count(Road_Type, name = "So_vu") %>%
mutate(Ty_le = 100 * So_vu / sum(So_vu)) %>%
arrange(desc(So_vu)) %>%
rename(`Loại đường` = Road_Type,`Số vụ` = So_vu,`Tỷ lệ (%)` = Ty_le )
road_type_summary_show <- road_type_summary_num %>%
mutate(`Số vụ` = format(`Số vụ`, big.mark=".", decimal.mark=",", trim=TRUE),`Tỷ lệ (%)`= percent(`Tỷ lệ (%)`/100, accuracy=0.01, decimal.mark=","))
road_type_summary_show## # A tibble: 4 × 3
## `Loại đường` `Số vụ` `Tỷ lệ (%)`
## <chr> <chr> <chr>
## 1 Đường nội bộ 670.536 38,05%
## 2 Cao tốc 486.626 27,61%
## 3 Khác 432.933 24,56%
## 4 Quốc lộ 172.357 9,78%Câu lệnh: (1) đếm số bản ghi theo biến Road_Type; (2) thêm cột ty_le = tỷ trọng (%) của từng loại đường trong tổng số vụ; (3) sắp xếp giảm dần theo số vụ; (4) đổi tên cột sang tiếng Việt.
Nhận xét:
Tai nạn tập trung nhiều nhất trên đường nội bộ (38,0%), tương ứng ~670.536 vụ, phản ánh mật độ phương tiện cao, ý thức chấp hành luật giao thông chưa tốt và hạ tầng đô thị hạn chế. Cao tốc (27,6%) đứng thứ hai, cho thấy dù có kiểm soát chặt chẽ, tốc độ cao vẫn làm tăng rủi ro va chạm nghiêm trọng.
Đường khác (24,6%) ở mức trung bình, nhiều khả năng gồm đường tỉnh/huyện/khu công nghiệp, nơi hạ tầng chưa đồng bộ. Quốc lộ (9,8%) thấp nhất, nhờ quản lý và bảo trì tốt, biển báo rõ ràng.
1.3.1.7 Thống kê tần suất số vụ tai nạn theo vùng miền
region_summary_num <- US %>%count(Region, name = "So_vu") %>%
mutate(Ty_le = 100 * So_vu / sum(So_vu)) %>%
arrange(desc(So_vu)) %>%
rename(`Vùng` = Region,`Số vụ`= So_vu,`Tỷ lệ (%)` = Ty_le)
region_summary_show <- region_summary_num %>%
mutate(`Số vụ` = format(`Số vụ`, big.mark=".", decimal.mark=",", trim=TRUE),`Tỷ lệ (%)` = percent(`Tỷ lệ (%)`/100, accuracy=0.01, decimal.mark=","))
region_summary_show## # A tibble: 5 × 3
## Vùng `Số vụ` `Tỷ lệ (%)`
## <chr> <chr> <chr>
## 1 Miền Nam (South) 648.115 36,77%
## 2 Miền Tây (West) 465.165 26,39%
## 3 Vùng khác 279.109 15,84%
## 4 Miền Đông Bắc (Northeast) 244.300 13,86%
## 5 Miền Trung Tây (Midwest) 125.763 7,14%Câu lệnh: (1) đếm số bản ghi theo Region; (2) thêm cột ty_le = tỷ lệ (%) mỗi vùng.
Nhận xét: Miền Nam (South) dẫn đầu với 36,8% tổng số vụ tai nạn, phản ánh dân số đông, lưu lượng phương tiện cao và mạng lưới đường phức tạp, khiến rủi ro va chạm lớn hơn. Miền Tây (West) xếp thứ hai với 26,4%, phù hợp với đặc điểm địa hình trải rộng và hệ thống cao tốc phát triển. Vùng khác chiếm 15,8%, trong khi Đông Bắc (13,9%) và Trung Tây (7,1%) có tỷ lệ thấp hơn, có thể nhờ hạ tầng tốt và quản lý giao thông hiệu quả.
1.3.1.8 Thống kê tần suất tai nạn theo hướng đi (Direction)
direction_frequency_num <- US %>%count(Direction, name = "So_vu") %>%
mutate(`Tỷ lệ (%)` = 100 * So_vu / sum(So_vu)) %>%
arrange(desc(So_vu)) %>%
rename(`Hướng` = Direction,`Số vụ` = So_vu)
direction_frequency_show <- direction_frequency_num %>%
mutate(`Số vụ` = format(`Số vụ`, big.mark=".", decimal.mark=",", trim=TRUE),`Tỷ lệ (%)` = percent(`Tỷ lệ (%)`/100, accuracy = 0.1, decimal.mark = ","),label_pct = `Tỷ lệ (%)` ) %>%
select(`Hướng`, `Số vụ`, `Tỷ lệ (%)`)
direction_frequency_show## # A tibble: 5 × 3
## Hướng `Số vụ` `Tỷ lệ (%)`
## <chr> <chr> <chr>
## 1 Không rõ/Khác 949.747 53,9%
## 2 South (Nam) 235.820 13,4%
## 3 North (Bắc) 225.971 12,8%
## 4 West (Tây) 177.148 10,1%
## 5 East (Đông) 173.766 9,9%Câu lệnh: (1) đếm số dòng theo biến Direction; (2) thêm cột ty_le là tỷ lệ dạng số thập phân của từng hướng (n chia tổng n).
Nhận xét:
Nhóm “Không rõ/Khác” chiếm 53,9%, cho thấy vấn đề chất lượng dữ liệu (thiếu mã hóa/ghi chép, chuẩn hóa không nhất quán). Tỷ trọng quá lớn ở nhóm này có thể gây thiên lệch ước lượng và giảm hiệu lực thống kê khi phân tích theo hướng đi.
Trong các hướng xác định, tỷ trọng khá sát nhau: Nam 13,4%, Bắc 12,8%, Tây 10,1%, Đông 9,9%. Chênh lệch nhỏ (≈3–4 điểm %) cho thấy hướng di chuyển không phải yếu tố chính; rủi ro nhiều khả năng chịu tác động mạnh hơn bởi loại đường, thời tiết/ánh sáng, giờ trong ngày, mật độ giao thông và hình học nút giao.
1.3.2 Thống kê mô tả biến định lượng
1.3.2.1 Thống kê mô tả biến khoảng cách (Distance)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0,0000 0,0570 0,2600 0,9264 0,9780 336,5700Câu lệnh: summary(): hàm thống kê mô tả nhanh biến Distance(mi)
*Nhận xét**: Distance (mi) có phân phối lệch phải rất mạnh: Median = 0,26 mi, Mean = 0,93 mi, Q3 = 0,98 mi, cho thấy đa số tai nạn chỉ ảnh hưởng trên đoạn ngắn (<1 mi), chủ yếu tại giao lộ, khu dân cư hoặc đô thị đông đúc. Min = 0 biểu thị các vụ gần như không lan tỏa, trong khi Max = 336,57 mi vượt xa Q3 (gấp ~340 lần), nhiều khả năng là ngoại lệ hoặc sự cố đặc biệt (tai nạn dây chuyền, chặn cao tốc, lỗi ghi nhận).
1.3.2.2 Thống kê mô tả biến độ ẩm (Humidity)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1,00 45,00 63,00 62,06 81,00 100,00Câu lệnh: summary(): hàm thống kê mô tả nhanh biến Humidity(%).
Nhận xét: Độ ẩm (Humidity%) trải từ 1%–100%, với trung vị = 63%, trung bình = 62,06%, cho thấy phân phối gần đối xứng, tập trung quanh mức ẩm trung bình – cao. Q1 = 45%, Q3 = 81% → một nửa số vụ tai nạn xảy ra trong khoảng 45–81%, tương ứng thời tiết ẩm ướt phổ biến. Giá trị 100% thường gắn với mưa hoặc sương mù, còn 1% nhiều khả năng là ngoại lệ đo sai.
1.3.2.3 Thống kê mô tả biến áp suất (Pressure)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0,00 29,21 29,72 29,38 29,96 58,63Câu lệnh: summary(US$Pressure(in)): gọi summary() để lấy thống kê mô tả cho cột áp suất khí quyển trong bảng US.
Nhận xét: Pressure (áp suất) tập trung rất chặt quanh mức chuẩn: Q1 = 29,21, Median = 29,72, Mean = 29,38, Q3 = 29,96 inHg, đúng với dải khí áp điển hình ở mực nước biển (~29,92 inHg). Độ phân tán nhỏ cho thấy phần lớn dữ liệu hợp lý. Tuy nhiên, hai cực trị Min = 0,00 và Max = 58,63 inHg là phi vật lý, khả năng cao do lỗi nhập hoặc thiết bị.
1.3.2.4 Thống kê mô tả biến thời gian bắt đầu (Start_Hour)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0,00 8,00 14,00 12,73 17,00 23,00Câu lệnh: summary(US$Start_Hour): gọi summary() để lấy thống kê mô tả cho giờ bắt đầu xảy ra tai nạn trong bảng US.
Nhận xét: Thời điểm bắt đầu tai nạn tập trung trong khung 8–17h, với Q1 = 8h, Median = 14h, Mean = 12,73h, Q3 = 17h. Phân phối hơi lệch trái, tức tai nạn xảy ra nhiều hơn vào buổi sáng – giữa trưa. Khoảng 50–75% số vụ diễn ra trong giờ làm việc, phù hợp quy luật lưu lượng giao thông đô thị.
1.3.2.5 Thống kê mô tả biến vĩ độ (Start_lat)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 24,55 33,01 35,91 35,95 39,99 49,00Câu lệnh: summary(US$Start_Lat): gọi summary() để lấy thống kê mô tả cho vĩ độ nơi xảy ra tai nạn trong bảng US.
Nhận xét: Start_Lat (vĩ độ nơi xảy ra tai nạn) phân bố chủ yếu trong dải 24,55°–49,00°, trùng với phạm vi lục địa Hoa Kỳ. Trung vị ≈ 35,9°, IQR ≈ 7°, cho thấy mức phân tán vừa phải, dữ liệu tập trung quanh vĩ độ 36°. Trung bình nhỉnh hơn trung vị (35,95 > 35,91) nên phân phối hơi lệch phải, tức nhiều vụ hơn ở vùng phía Bắc.
1.3.3 Thống kê tần số một vài biến theo nhóm
1.3.3.1 Mức độ nghiêm trọng, thời lượng trung bình theo vùng × mùa
withr::local_options(list(width = 160, tibble.width = Inf, pillar.width = 160))
region_season_num <- US %>%group_by(Region, Season) %>%
summarise(So_vu = n(),Severity_TB = mean(Severity, na.rm = TRUE),
Thoi_luong_TB_phut = mean(Duration_Minutes, na.rm = TRUE), .groups = "drop") %>%
arrange(Region, desc(Severity_TB)) %>%
rename(`Vùng` = Region,`Mùa` = Season,`Số vụ` = So_vu,`Mức độ TB` = Severity_TB,`Thời lượng TB (phút)` = Thoi_luong_TB_phut)
region_season_show <- region_season_num %>%
mutate(`Số vụ`= format(`Số vụ`, big.mark=".", decimal.mark=",", trim=TRUE),`Mức độ TB` = format(round(`Mức độ TB`, 2), decimal.mark=",", trim=TRUE),`Thời lượng TB (phút)` = format(round(`Thời lượng TB (phút)`, 2), big.mark=".", decimal.mark=",", trim=TRUE))
print(region_season_show, n = Inf, width = Inf) ## # A tibble: 20 × 5
## Vùng Mùa `Số vụ` `Mức độ TB` `Thời lượng TB (phút)`
## <chr> <chr> <chr> <chr> <chr>
## 1 Miền Nam (South) Mùa Đông 180.405 2,08 145,31
## 2 Miền Nam (South) Mùa Thu 123.063 2,06 124,03
## 3 Miền Nam (South) Mùa Xuân 201.978 2,06 123,67
## 4 Miền Nam (South) Mùa Hè 142.669 2,04 110,50
## 5 Miền Trung Tây (Midwest) Mùa Xuân 26.165 2,12 117,03
## 6 Miền Trung Tây (Midwest) Mùa Đông 43.024 2,11 106,81
## 7 Miền Trung Tây (Midwest) Mùa Hè 29.415 2,10 208,31
## 8 Miền Trung Tây (Midwest) Mùa Thu 27.159 2,07 126,97
## 9 Miền Tây (West) Mùa Hè 112.716 2,06 137,96
## 10 Miền Tây (West) Mùa Đông 125.724 2,05 160,28
## 11 Miền Tây (West) Mùa Xuân 130.751 2,05 164,35
## 12 Miền Tây (West) Mùa Thu 95.974 2,02 140,74
## 13 Miền Đông Bắc (Northeast) Mùa Đông 58.333 2,12 161,36
## 14 Miền Đông Bắc (Northeast) Mùa Xuân 58.986 2,10 181,13
## 15 Miền Đông Bắc (Northeast) Mùa Hè 70.548 2,07 139,82
## 16 Miền Đông Bắc (Northeast) Mùa Thu 56.433 2,06 151,06
## 17 Vùng khác Mùa Đông 81.161 2,13 2.988,50
## 18 Vùng khác Mùa Xuân 78.518 2,12 1.659,21
## 19 Vùng khác Mùa Hè 66.949 2,11 154,25
## 20 Vùng khác Mùa Thu 52.481 2,10 158,89Câu lệnh: (1) gom nhóm dữ liệu theo vùng và mùa; (2) tạo bảng tóm tắt; (4) sắp xếp theo Region, rồi giảm dần theo mức độ nghiêm trọng trung bình.
Nhận xét:
Miền Nam (South) có số vụ tai nạn cao nhất (142.000–201.000 vụ mỗi mùa), phản ánh mật độ giao thông và dân cư lớn. Miền Tây và Trung Tây thấp hơn (27.000–125.000 vụ), cho thấy áp lực giao thông nhẹ hơn.
Mức độ nghiêm trọng trung bình ổn định (2,04–2,12), gần như không bị ảnh hưởng bởi mùa, mà phụ thuộc nhiều hơn vào loại đường, thời tiết cụ thể và hành vi lái xe.
Thời lượng tai nạn biến động rõ: South cao nhất mùa Đông (145 phút), thấp nhất mùa Hè (110 phút); Midwest mùa Hè vượt trội (208 phút), có thể do tai nạn ở cao tốc hoặc khu vực nông thôn, nơi cứu hộ và giải tỏa chậm hơn.
1.3.3.2 Theo loại đường và vùng miền
withr::local_options(list(width = 160, tibble.width = Inf, pillar.width = 160))
road_region_num <- US %>% group_by(Road_Type, Region) %>%summarise(Count = n(),
Severity_Mean = mean(Severity, na.rm = TRUE),
Duration_Median_Min = median(Duration_Minutes, na.rm = TRUE),
.groups = "drop") %>%
arrange(Road_Type, desc(Severity_Mean)) %>%
rename(`Loại đường` = Road_Type,`Vùng`= Region,`Số vụ`= Count,`Mức độ TB` = Severity_Mean,`Trung vị thời lượng (phút)` = Duration_Median_Min)
road_region_show <- road_region_num %>%
mutate(`Số vụ` = format(`Số vụ`, big.mark=".", decimal.mark=",", trim=TRUE),`Mức độ TB` = format(round(`Mức độ TB`, 2), decimal.mark=",", trim=TRUE),`Trung vị thời lượng (phút)`= format(round(`Trung vị thời lượng (phút)`, 2), big.mark=".", decimal.mark=",", trim=TRUE))
print(road_region_show, n = Inf, width = Inf)## # A tibble: 20 × 5
## `Loại đường` Vùng `Số vụ` `Mức độ TB` `Trung vị thời lượng (phút)`
## <chr> <chr> <chr> <chr> <chr>
## 1 Cao tốc Miền Trung Tây (Midwest) 48.686 2,16 78,43
## 2 Cao tốc Miền Nam (South) 146.062 2,15 78,95
## 3 Cao tốc Vùng khác 119.572 2,14 81,17
## 4 Cao tốc Miền Đông Bắc (Northeast) 54.508 2,12 104,53
## 5 Cao tốc Miền Tây (West) 117.798 2,09 103,96
## 6 Khác Miền Trung Tây (Midwest) 18.901 2,11 76,00
## 7 Khác Vùng khác 47.415 2,10 78,18
## 8 Khác Miền Đông Bắc (Northeast) 87.113 2,08 105,87
## 9 Khác Miền Nam (South) 151.161 2,06 78,07
## 10 Khác Miền Tây (West) 128.343 2,02 82,97
## 11 Quốc lộ Vùng khác 32.764 2,19 78,48
## 12 Quốc lộ Miền Đông Bắc (Northeast) 17.006 2,10 93,61
## 13 Quốc lộ Miền Nam (South) 54.537 2,09 78,00
## 14 Quốc lộ Miền Trung Tây (Midwest) 19.188 2,05 82,23
## 15 Quốc lộ Miền Tây (West) 48.862 2,04 84,50
## 16 Đường nội bộ Miền Đông Bắc (Northeast) 85.673 2,08 89,17
## 17 Đường nội bộ Vùng khác 79.358 2,05 78,03
## 18 Đường nội bộ Miền Trung Tây (Midwest) 38.988 2,04 75,17
## 19 Đường nội bộ Miền Tây (West) 170.162 2,03 85,45
## 20 Đường nội bộ Miền Nam (South) 296.355 2,01 78,25Câu lệnh: (1) gộp theo Loại đường và Vùng; (2) đếm số vụ trong mỗi nhóm; (5) trong từng Loại đường, sắp xếp vùng theo nghiêm trọng TB giảm dần.
Nhận xét:
Hai vùng South và West ghi nhận số vụ tai nạn cao nhất (khoảng 128–151 nghìn vụ), phản ánh mật độ phương tiện và mạng lưới giao thông dày đặc. Nhóm “Vùng khác” cũng chiếm tỷ trọng đáng kể (~87–120 nghìn vụ).
Mức độ nghiêm trọng trung bình khá đồng đều (2,02–2,16), cho thấy vùng hay loại đường không ảnh hưởng mạnh đến hậu quả tai nạn; mức cao hơn ở Midwest (~2,16) có thể do điều kiện băng tuyết hoặc tầm nhìn hạn chế.
Thời lượng trung vị dao động 76–106 phút, cao nhất tại West và Midwest, gợi ý việc cứu hộ kéo dài vì địa hình rộng; trong khi South thấp hơn (~78 phút), phản ánh hệ thống phản ứng nhanh hơn.
1.3.3.3 Mức độ nghiêm trọng và thời lượng theo vùng
region_analysis_num <- US %>% group_by(Region) %>%
summarise(So_vu = n(),Severity_TB = mean(Severity, na.rm = TRUE),
Thoi_luong_TB_phut = mean(Duration_Minutes, na.rm = TRUE),
.groups = "drop") %>%
arrange(desc(Severity_TB)) %>%
rename(`Vùng` = Region,`Số vụ` = So_vu,`Mức độ TB` = Severity_TB,
`Thời lượng TB (phút)` = Thoi_luong_TB_phut)
region_analysis_show <- region_analysis_num %>%
mutate(`Số vụ` = format(`Số vụ`, big.mark=".", decimal.mark=",", trim=TRUE),`Mức độ TB` = format(round(`Mức độ TB`, 2), decimal.mark=",", trim=TRUE),`Thời lượng TB (phút)` = format(round(`Thời lượng TB (phút)`, 2),big.mark=".", decimal.mark=",", trim=TRUE))
region_analysis_show## # A tibble: 5 × 4
## Vùng `Số vụ` `Mức độ TB` `Thời lượng TB (phút)`
## <chr> <chr> <chr> <chr>
## 1 Vùng khác 279.109 2,11 1.402,65
## 2 Miền Trung Tây (Midwest) 125.763 2,10 137,03
## 3 Miền Đông Bắc (Northeast) 244.300 2,09 157,53
## 4 Miền Nam (South) 648.115 2,06 126,86
## 5 Miền Tây (West) 465.165 2,04 151,99Câu lệnh: (1) gom nhóm theo vùng; (2) đếm số vụ trong mỗi vùng; (5) sắp xếp giảm dần theo nghiêm trọng TB để vùng “nặng” đứng trước.
Nhận xét:
Tai nạn tập trung ở Miền Nam (648.000) và Miền Tây (465.000), tiếp đến là Đông Bắc (244.000), Trung Tây (126.000) và Vùng khác (279.000), phản ánh mật độ giao thông và đô thị hóa cao tại South và West.
Mức độ nghiêm trọng ổn định (2,04–2,11), cho thấy vùng địa lý ít ảnh hưởng so với yếu tố hiện trường.
Thời lượng trung bình 127–158 phút; riêng “Vùng khác” ≈1.402 phút là ngoại lệ, có thể do lỗi dữ liệu hoặc sự cố đặc biệt.
1.3.3.4 Phân tích phân vị thời lượng tai nạn theo loại đường
stat12_num <- US %>%group_by(Road_Type) %>%
summarise(n = n(), q10 = quantile(Duration_Minutes, 0.10, na.rm = TRUE),q50 = quantile(Duration_Minutes, 0.50, na.rm = TRUE), q90 = quantile(Duration_Minutes, 0.90, na.rm = TRUE),.groups = "drop") %>%
rename(`Loại đường` = Road_Type,`Số vụ` = n,`p10 (phút)` = q10,
`Trung vị (phút)` = q50,`p90 (phút)` = q90)
stat12_show <- stat12_num %>%
mutate(`Số vụ` = format(`Số vụ`, big.mark=".", decimal.mark=",", trim=TRUE),`p10 (phút)`= format(round(`p10 (phút)`, 2), decimal.mark=",", trim=TRUE),`Trung vị (phút)` = format(round(`Trung vị (phút)`, 2), decimal.mark=",", trim=TRUE), `p90 (phút)` = format(round(`p90 (phút)`, 2), decimal.mark=",", trim=TRUE))
stat12_show## # A tibble: 4 × 5
## `Loại đường` `Số vụ` `p10 (phút)` `Trung vị (phút)` `p90 (phút)`
## <chr> <chr> <chr> <chr> <chr>
## 1 Cao tốc 486.626 29,08 84,98 226,42
## 2 Khác 432.933 29,32 81,77 198,07
## 3 Quốc lộ 172.357 29,33 80,00 172,27
## 4 Đường nội bộ 670.536 29,68 79,72 152,22Câu lệnh: (1) gom nhóm dữ liệu theo loại đường (cao tốc, quốc lộ, đô thị, khác); (2) tính toán cho từng nhóm; q10, q50, q90: lần lượt là các phân vị 10%, 50% (trung vị) và 90% của biến Duration_Minutes, phản ánh mức thời lượng mà 10%, 50% và 90% số vụ tai nạn có thời gian nhỏ hơn giá trị đó.
Nhận xét:
Cao tốc có thời lượng trung vị cao nhất (85 phút), cho thấy tai nạn thường kéo dài hơn do tốc độ và phạm vi ảnh hưởng lớn. Đường đô thị và quốc lộ thấp hơn (79–82 phút) nhưng vẫn có phân vị 90% cao, phản ánh một số vụ kéo dài bất thường.
Nhóm “Khác” có phân vị 90% 198 phút, biến động mạnh, có thể do địa hình khó tiếp cận hoặc loại đường không chuẩn hóa. Sự chênh lệch lớn giữa q10–q90 ở mọi nhóm cho thấy phân phối lệch phải, tức vẫn tồn tại nhiều vụ kéo dài vượt xa trung vị.
1.3.3.5 Mức độ nghiêm trọng trung bình theo vùng × nhóm thời tiết
US5 <- US %>%mutate(Weather_Simple = case_when(str_detect(Weather_Condition, regex("rain|storm|drizzle", ignore_case = TRUE)) ~ "Mưa",str_detect(Weather_Condition, regex("snow|sleet|ice|blizzard", ignore_case = TRUE)) ~ "Tuyết/Băng",
str_detect(Weather_Condition, regex("fog|mist|haze|smoke", ignore_case = TRUE)) ~ "Sương mù",str_detect(Weather_Condition, regex("clear|fair", ignore_case = TRUE)) ~ "Quang đãng",TRUE ~ "Khác"))
weather_region_num <- US5 %>%group_by(Region, Weather_Simple) %>%
summarise(So_vu = n(), Muc_do_TB = mean(Severity, na.rm = TRUE), .groups = "drop") %>%
arrange(Region, desc(Muc_do_TB)) %>%
rename(`Vùng` = Region,`Thời tiết` = Weather_Simple,`Số vụ` = So_vu,`Mức độ TB` = Muc_do_TB)
weather_region_show <- weather_region_num %>%
mutate(`Số vụ` = format(`Số vụ`, big.mark=".", decimal.mark=",", trim=TRUE),`Mức độ TB` = format(round(`Mức độ TB`, 2), decimal.mark=",", trim=TRUE))
weather_region_show## # A tibble: 25 × 4
## Vùng `Thời tiết` `Số vụ` `Mức độ TB`
## <chr> <chr> <chr> <chr>
## 1 Miền Nam (South) Tuyết/Băng 2.480 2,11
## 2 Miền Nam (South) Mưa 47.507 2,08
## 3 Miền Nam (South) Sương mù 8.815 2,07
## 4 Miền Nam (South) Quang đãng 306.550 2,06
## 5 Miền Nam (South) Khác 282.763 2,06
## 6 Miền Trung Tây (Midwest) Mưa 8.262 2,13
## 7 Miền Trung Tây (Midwest) Khác 52.527 2,10
## 8 Miền Trung Tây (Midwest) Quang đãng 45.680 2,09
## 9 Miền Trung Tây (Midwest) Tuyết/Băng 16.256 2,09
## 10 Miền Trung Tây (Midwest) Sương mù 3.038 2,06
## # ℹ 15 more rowsCâu lệnh: (1) gom Weather_Condition vào 5 nhóm: Mưa, Tuyết/Băng, Sương mù, Quang đãng, Khác; (3) nhóm theo vùng và nhóm thời tiếtiết; (4) tính số vụ và mức độ nghiêm trọng trung bình của từng nhóm.
Nhận xét:
Mức độ nghiêm trọng trung bình (≈2,06–2,13) giữa các tổ hợp Vùng × Thời tiết dao động hẹp nhưng có mẫu hình rõ: Tuyết/Băng và Sương mù cao nhất, Mưa ở mức trung gian, Quang đãng và Khác thấp nhất. -> Điều này phản ánh rủi ro từ đường trơn và tầm nhìn kém.
Theo vùng, Midwest có mức cao hơn ở nhóm Tuyết/Băng, trong khi South và West chênh lệch rõ giữa Mưa và Quang đãng. Ở đô thị, Sương mù tuy ít vụ nhưng thường nghiêm trọng hơn do tầm nhìn hạn chế.
1.3.3.6 Theo vùng × khung giờ: Số vụ và Mức độ nghiêm trọng trung bình
US_t <- US %>%mutate(Hour = as.integer(format(Start_Time, "%H")),
Khung_gio = case_when(Hour %in% 6:11 ~ "Sáng", Hour %in% 12:17 ~ "Chiều",Hour %in% 18:23 ~ "Tối",TRUE ~ "Khuya"))
stat_d_num <- US_t %>%group_by(Region, Khung_gio) %>%
summarise(So_vu = n(), Nghiem_trong_TB = mean(Severity, na.rm = TRUE),.groups = "drop") %>%
rename(`Vùng` = Region,`Khung giờ` = Khung_gio,`Số vụ (n)` = So_vu,
`Nghiêm trọng TB` = Nghiem_trong_TB)
stat_d_show <- stat_d_num %>%mutate(`Số vụ (n)` = format(`Số vụ (n)`, big.mark=".", decimal.mark=",", trim=TRUE),`Nghiêm trọng TB` = format(round(`Nghiêm trọng TB`, 2),decimal.mark=",", trim=TRUE))
stat_d_show ## # A tibble: 20 × 4
## Vùng `Khung giờ` `Số vụ (n)` `Nghiêm trọng TB`
## <chr> <chr> <chr> <chr>
## 1 Miền Nam (South) Chiều 294.446 2,06
## 2 Miền Nam (South) Khuya 45.993 2,08
## 3 Miền Nam (South) Sáng 187.887 2,02
## 4 Miền Nam (South) Tối 119.789 2,10
## 5 Miền Trung Tây (Midwest) Chiều 50.675 2,10
## 6 Miền Trung Tây (Midwest) Khuya 11.140 2,14
## 7 Miền Trung Tây (Midwest) Sáng 42.303 2,08
## 8 Miền Trung Tây (Midwest) Tối 21.645 2,10
## 9 Miền Tây (West) Chiều 191.027 2,04
## 10 Miền Tây (West) Khuya 49.779 2,05
## 11 Miền Tây (West) Sáng 132.755 2,05
## 12 Miền Tây (West) Tối 91.604 2,04
## 13 Miền Đông Bắc (Northeast) Chiều 98.109 2,08
## 14 Miền Đông Bắc (Northeast) Khuya 24.391 2,13
## 15 Miền Đông Bắc (Northeast) Sáng 76.009 2,06
## 16 Miền Đông Bắc (Northeast) Tối 45.791 2,13
## 17 Vùng khác Chiều 113.982 2,11
## 18 Vùng khác Khuya 25.300 2,13
## 19 Vùng khác Sáng 90.807 2,09
## 20 Vùng khác Tối 49.020 2,15Câu lệnh: (1) Tạo biến Hour từ Start_Time, rồi case_when() gộp thành Khung_gio; (3) nhóm theo vùng và khung giờ; (4)đếm số vụ và tính mức độ nghiêm trọng trung bình cho mỗi nhóm.
Nhận xét:
Số liệu cho thấy tai nạn tập trung vào giờ hành chính, với buổi chiều cao nhất (~294.000 vụ) và buổi sáng đứng thứ hai (188.000 vụ) – phản ánh hiệu ứng đi làm, tan ca khi lưu lượng phương tiện tăng. Khuya ghi nhận ít vụ nhất (46.000), phù hợp với lưu lượng thấp.
Mức độ nghiêm trọng trung bình dao động quanh 2,02–2,10, nhưng có xu hướng cao hơn vào Tối và Khuya (2,08–2,10) và thấp hơn vào Sáng, Chiều (2,02–2,06). Điều này cho thấy ban đêm tốc độ cao, mệt mỏi hoặc rượu bia làm tăng rủi ro, còn ban ngày va chạm nhẹ chiếm ưu thế do giao thông đông.
1.3.3.7 Tầm nhìn × mùa: Quy mô, tỷ lệ nặng và thời lượng trung bình
US_v <- US %>%mutate(`Nhóm tầm nhìn` = cut(`Visibility(mi)`, breaks = c(0, 1, 3, 5, 10, Inf),labels = c("≤1", "1–3", "3–5", "5–10", ">10"), include.lowest = TRUE))
stat_g_num <- US_v %>%group_by(Season, `Nhóm tầm nhìn`) %>%
summarise(`Số vụ` = n(), `% Severity≥3` = mean(Severity >= 3, na.rm = TRUE) * 100, `Thời lượng TB (phút)` = mean(Duration_Minutes, na.rm = TRUE),.groups = "drop") %>%
rename(`Mùa` = Season) %>%
arrange(`Mùa`, `Nhóm tầm nhìn`)
stat_g_show <- stat_g_num %>%
mutate(`Số vụ` = format(`Số vụ`, big.mark=".", decimal.mark=",", trim=TRUE),`% Severity≥3` = percent(`% Severity≥3`/100, accuracy=0.1, decimal.mark=","), `Thời lượng TB (phút)` = format(round(`Thời lượng TB (phút)`, 2),big.mark=".", decimal.mark=",", trim=TRUE))
stat_g_show ## # A tibble: 20 × 5
## Mùa `Nhóm tầm nhìn` `Số vụ` `% Severity≥3` `Thời lượng TB (phút)`
## <chr> <fct> <chr> <chr> <chr>
## 1 Mùa Hè ≤1 4.106 9,9% 107,37
## 2 Mùa Hè 1–3 5.186 10,9% 109,80
## 3 Mùa Hè 3–5 6.669 11,4% 118,46
## 4 Mùa Hè 5–10 404.803 9,5% 137,53
## 5 Mùa Hè >10 1.533 12,9% 105,56
## 6 Mùa Thu ≤1 7.989 3,8% 138,30
## 7 Mùa Thu 1–3 9.539 3,6% 135,46
## 8 Mùa Thu 3–5 9.893 3,1% 130,12
## 9 Mùa Thu 5–10 326.663 3,4% 138,62
## 10 Mùa Thu >10 1.026 4,5% 114,20
## 11 Mùa Xuân ≤1 12.150 8,4% 389,09
## 12 Mùa Xuân 1–3 11.409 9,7% 345,91
## 13 Mùa Xuân 3–5 11.433 9,2% 254,10
## 14 Mùa Xuân 5–10 460.063 7,1% 388,05
## 15 Mùa Xuân >10 1.343 8,4% 287,11
## 16 Mùa Đông ≤1 32.496 6,3% 422,75
## 17 Mùa Đông 1–3 25.453 6,4% 309,90
## 18 Mùa Đông 3–5 21.409 6,6% 635,10
## 19 Mùa Đông 5–10 408.115 6,7% 655,67
## 20 Mùa Đông >10 1.174 10,7% 95,54Câu lệnh: (1) chia tầm nhìn thành 5 nhóm: ≤1; 1-3; 3-5; 5-10; >10 (bao gồm cả biên); (2) đếm số vụ, tính tỷ lệ vụ nặng, thời lượng trung bình.
Nhận xét: Trong Mùa Hè, tầm nhìn rất thấp (≤1 mi) đi kèm tỷ lệ vụ nặng cao (~9,9%) và thời lượng dài (~107–118 phút); đáng chú ý, nhóm >10 mi dù nhìn tốt vẫn có tỷ lệ nặng cao nhất (~12,9%), gợi ý rủi ro do tốc độ hành trình cao. Mùa Thu có tỷ lệ nặng thấp hơn (3–4,5%) nhưng thời lượng trung bình dài (~130–138 phút), cho thấy yếu tố cứu hộ/hạ tầng chi phối. Tổng thể, mối quan hệ mang dạng chữ U: rủi ro nặng cao ở hai cực tầm nhìn (rất kém và rất tốt), còn mức trung bình (3–10 mi) ít rủi ro hơn.
1.3.3.8 Theo Vùng: số vụ và Thời lượng trung vị của sự cố (phút)
stat_1_num <- US %>%mutate(Start_Time = as.POSIXct(Start_Time, tz = "UTC")) %>%
group_by(Region) %>%
summarise(So_vu = n(),Thoi_luong_trung_vi_phut = median(Duration_Minutes, na.rm = TRUE),.groups = "drop") %>%
rename(`Vùng` = Region)
stat_1_show <- stat_1_num %>%
mutate(`Số vụ` = format(So_vu, big.mark = ".", decimal.mark = ",", trim = TRUE),`Thời lượng trung vị (phút)` = format(round(Thoi_luong_trung_vi_phut, 2), big.mark = ".", decimal.mark = ",", trim = TRUE)) %>% select(`Vùng`, `Số vụ`, `Thời lượng trung vị (phút)`)
stat_1_show## # A tibble: 5 × 3
## Vùng `Số vụ` `Thời lượng trung vị (phút)`
## <chr> <chr> <chr>
## 1 Miền Nam (South) 648.115 78,15
## 2 Miền Trung Tây (Midwest) 125.763 77,55
## 3 Miền Tây (West) 465.165 88,67
## 4 Miền Đông Bắc (Northeast) 244.300 99,47
## 5 Vùng khác 279.109 78,85Câu lệnh: (1) đảm bảo kiểu thời gian chuẩn; (2) Nhóm theo vùng; (3) đếm Số vụ (n) và tính thời lượng trung vị (phút) cho mỗi vùng.
Nhận xét: Vùng Miền Nam có số vụ tai nạn lớn nhất (648.115 vụ), tiếp theo là Miền Tây (465.165 vụ), phản ánh mức độ đô thị hóa, dân cư đông và lưu lượng giao thông cao hơn các vùng khác. Về thời lượng trung vị, Miền Đông Bắc cao nhất (99,5 phút), kế đến Miền Tây (88,7 phút), trong khi Miền Trung Tây thấp nhất (77,6 phút). Điều này cho thấy sự khác biệt về hạ tầng và khả năng ứng cứu: miền Đông Bắc có mạng đường dày và thời tiết khắc nghiệt nên xử lý chậm hơn; miền Tây có nhiều cao tốc dài, ít tuyến thay thế; miền Trung Tây phân luồng tốt nên khắc phục nhanh; còn miền Nam tuy nhiều vụ nhất nhưng giải tỏa hiệu quả hơn, phản ánh năng lực xử lý sự cố tốt.
1.4 Trực quan hoá bộ dữ liệu
1.4.1 Không gian và toạ độ
1.4.1.1 10 tuyến đường có mật độ tai nạn cao
options(sf_use_s2 = FALSE)
nms <- names(Acc); nms_low <- tolower(nms)
find_col <- function(cands){ i <- which(nms_low %in% tolower(cands))[1]; if(length(i)==0) NA_character_ else nms[i] }
lon_col <- find_col(c("lon","lng","longitude","start_lng","end_lng","start_lon","end_lon","x"))
lat_col <- find_col(c("lat","latitude","start_lat","end_lat","y"))
if (is.na(lon_col) || is.na(lat_col)) { print(nms); stop("Không tìm thấy cột kinh độ/vĩ độ trong Acc.") }
Acc <- Acc |> rename(lon = all_of(lon_col), lat = all_of(lat_col))
crs_albers <- 5070
usa_states <- rnaturalearth::ne_states(
country = "United States of America",
returnclass = "sf") |>
st_transform(crs_albers)
states_conus <- subset(usa_states, !(name %in% c("Alaska","Hawaii","Puerto Rico")))
bbox_conus <- st_as_sfc(st_bbox(c(xmin = -2400000, xmax = 2500000,ymin = 150000, ymax = 3200000),crs = st_crs(crs_albers)))
states_conus <- st_intersection(states_conus, bbox_conus)
pts <- st_as_sf(Acc, coords = c("lon","lat"), crs = 4326) |> st_transform(crs_albers)
xy <- st_coordinates(pts) |> as.data.frame() |> rename(x = X, y = Y)
has_street <- "Street" %in% names(Acc)
if (has_street) {top10_names <- Acc |> count(Street, sort = TRUE) |> slice_head(n = 10) |> pull(Street)
top10_xy <- Acc |> filter(Street %in% top10_names) |>group_by(Street) |>
summarise(lon = median(lon, na.rm = TRUE),lat = median(lat, na.rm = TRUE), .groups = "drop") |>st_as_sf(coords = c("lon","lat"), crs = 4326) |>
st_transform(crs_albers) |>
(\(s) cbind(st_coordinates(s) |> as.data.frame() |> rename(X = X, Y = Y), Street = s$Street))()}
ggplot() +
theme_void() +
geom_sf(data = states_conus, fill = "grey96", color = "grey85", linewidth = 0.3) +
stat_bin_hex(data = xy, aes(x, y, fill = after_stat(log1p(count))),bins = 70, alpha = 0.95) +
scale_fill_viridis_c(name = "log(1 + số vụ)", option = "D") +
geom_sf(data = states_conus, fill = NA, color = "white", linewidth = 0.3) + { if (has_street) geom_label_repel(data = top10_xy, aes(X, Y, label = Street),size = 3.2, fontface = "bold",label.size = 0.2, label.r = unit(2, "pt"),fill = scales::alpha("white", 0.8), color = "black",box.padding = 0.5, min.segment.length = 0) else NULL } +
coord_sf(crs = crs_albers, expand = FALSE, xlim = st_bbox(bbox_conus)[c("xmin","xmax")],ylim = st_bbox(bbox_conus)[c("ymin","ymax")]) +
labs(title = "TOP 10 TUYẾN ĐƯỜNG CÓ MẬT ĐỘ TAI NẠN CAO)",
subtitle = "Ô lục giác đậm hơn → khu vực có nhiều vụ tai nạn hơn") +
theme(panel.background = element_rect(fill = "grey97", color = NA),
plot.title = element_text(family = "Times New Roman", face = "bold", size = 12, hjust=0.5),plot.subtitle = element_text(family = "Times New Roman", color = "grey30", hjust=0.5),plot.caption = element_text(family = "Times New Roman", size = 9, color = "grey40"),legend.title = element_text(family = "Times New Roman"),legend.text = element_text(family = "Times New Roman"),plot.margin = margin(10,16,10,16))
Câu lệnh: (4–5) Tìm cột kinh độ & vĩ độ; (6) Dừng nếu thiếu, ngược lại đổi tên về lon, lat; (7) Chọn hệ tọa độ Albers US (EPSG:5070); (8) Nạp ranh giới bang Mỹ (sf) và đổi sang Albers; (12) Đổi Acc thành điểm sf (WGS84 → Albers); (13) Trích toạ độ X, Y làm data frame; (15) lấy top 10 tên đường theo số vụ; (16) Tính vị trí nhãn (kinh/vĩ độ median) của từng đường, đổi sang Albers; (17) Khởi tạo ggplot; (19) Vẽ polygon các bang (fill xám nhạt, viền xám); (20) Hexbin điểm tai nạn (đếm log1p, 70 bins).
Nhận xét: Các tuyến I-95 (bờ Đông), I-5 (bờ Tây) và I-10 (miền Nam) hiện rõ là trục có mật độ cao. Các đô thị lớn như New York, Los Angeles, Chicago, Houston là điểm nóng nổi bật, trong khi vùng núi và sa mạc (Rockies, Arizona) có màu nhạt hơn, phản ánh lưu lượng xe thấp. Mật độ tai nạn cao tập trung ở nơi giao thông dày đặc, tốc độ cao, nhiều nút giao phức tạp. Ngoài ra, điều kiện hạ tầng, thời tiết và địa hình cũng góp phần tạo ra các vùng rủi ro khác biệt. Vùng thưa dân hoặc hiểm trở tuy có ít xe nhưng vẫn có thể xuất hiện điểm nguy cơ do đường dốc, tầm nhìn hạn chế.
1.4.1.2 Bản đồ điểm nóng theo bang
state_counts <- Acc %>% filter(!is.na(State)) %>%
count(State) %>% arrange(desc(n))
top_12_names <- state_counts %>% head(12) %>% pull(State)
us_map <- ne_states(country = "United States of America", returnclass = "sf")
map_data <- left_join(us_map, state_counts, by = c("postal" = "State"))
map_data <- map_data %>% mutate(Count_Top_12 = ifelse(postal %in% top_12_names, n, NA))
ggplot(data = map_data) + geom_sf(fill = "grey90", color = "white") +
geom_sf(aes(fill = Count_Top_12), color = "white") +
geom_sf_label(data = filter(map_data, postal %in% top_12_names),
aes(label = postal),color = "black", fill = "white", alpha = 0.7,size = 3,fontface = "bold", label.padding = unit(0.15, "lines")) +
scale_fill_viridis_c(option = "cividis",name = "Số vụ tai nạn (Top 12)",labels = scales::number_format(big.mark = ".")) +
coord_sf(xlim = c(-125, -65), ylim = c(25, 50), clip = "on") +
labs(title = "12 BANG CÓ TAI NẠN NHIỀU NHẤT",subtitle = "Các bang được tô màu dựa trên tổng số vụ tai nạn") + theme_void(base_family = "Times New Roman", base_size = 14) +
theme(plot.title = element_text(face = "bold", hjust = 0.5, size = 16), plot.subtitle = element_text(hjust = 0.5, color = "gray50"),
legend.position = "bottom",legend.key.width = unit(2, "cm"))
Câu lệnh: (1–2) đếm số vụ tai nạn theo bang và sắp xếp giảm dần; (3) lấy 12 bang có số vụ cao nhất; (4–5) tải bản đồ bang Mỹ và gộp với dữ liệu tai nạn; (6) tạo biến chỉ tô màu cho 12 bang top; (7–8) vẽ bản đồ nền và tô màu theo số vụ; (9–18) thêm nhãn viết tắt bang top 12, chỉnh màu, cỡ chữ; (19) đặt thang màu viridis; (21–22) thêm tiêu đề, phụ đề; (23–28) chỉnh theme, font Times New Roman, căn giữa tiêu đề.
Nhận xét: Những bang đông dân và có mạng lưới giao thông lớn chiếm ưu thế: California (CA) ở Bờ Tây; Texas (TX) và Florida (FL) ở miền Nam; cụm Đông Bắc – Trung Đại Tây Dương gồm NY, PA, NJ, VA; cùng một số bang Trung Tây/Đông Nam như MN, TN, NC, SC, AZ. Cấu trúc này phù hợp quy luật: dân số và lưu lượng di chuyển (VMT) càng cao → tai nạn tuyệt đối càng nhiều.
1.4.1.3 Tỷ lệ thành phần loại đường gây tai nạn theo khu vực
comp2 <- Acc %>%filter(!is.na(Region), !is.na(Road_Type)) %>%
count(Region, Road_Type, name = "n") %>%
group_by(Region) %>%
mutate(pct = n / sum(n),lbl1 = percent(pct, accuracy = 0.1, decimal.mark = ",", big.mark = "."),
inside = pct >= 0.14 ) %>%
ungroup() %>%
group_by(Region) %>%
mutate(Road_Type = fct_reorder(Road_Type, pct)) %>%
ungroup()
lab_region <- c("Other" = "Vùng khác",
"Northeast" = "Miền Đông Bắc (Northeast)",
"West" = "Miền Tây (West)",
"Midwest" = "Miền Trung Tây (Midwest)",
"South" = "Miền Nam (South)")
okabe_ito <- c("#E69F00","#56B4E9","#009E73","#F0E442",
"#0072B2","#D55E00","#CC79A7","#999999")
p <- ggplot(comp2, aes(x = pct, y = Road_Type, fill = Road_Type)) +
geom_col(width = 0.6, show.legend = FALSE) +
geom_text(data = subset(comp2, inside),aes(x = pmax(pct - 0.012, 0.012), label = lbl1),
hjust = 1, color = "white", size = 2.6, fontface = "bold",
family = "Times New Roman") +
geom_text(data = subset(comp2, !inside),
aes(x = pct + 0.012, label = lbl1),
hjust = 0, color = "black", size = 2.6, fontface = "bold",
family = "Times New Roman") +
facet_wrap(~ Region, ncol = 3, scales = "free_y",labeller = labeller(Region = lab_region)) +
scale_x_continuous(limits = c(0, NA),
breaks = seq(0, 0.5, 0.1),
labels = label_percent(accuracy = 1, decimal.mark = ",", big.mark = "."),
expand = ggplot2::expansion(mult = c(0, .18)) ) +
coord_cartesian(clip = "off") +
scale_fill_manual(values = rep(okabe_ito, length.out = nlevels(comp2$Road_Type))) +
labs(title = "PHÂN BỐ TỶ LỆ TAI NẠN THEO LOẠI ĐƯỜNG TRONG TỪNG VÙNG",x = NULL, y = NULL) +
theme_minimal(base_family = "Times New Roman") +
theme(plot.title = element_text(face = "bold", size = 12, hjust = .5, colour = "#0f2343"),
strip.text = element_text(face = "bold", colour = "#0f2343", size = 11, margin = margin(b = 8)),
strip.background = element_blank(),
axis.text.x = element_text(size = 9),
axis.text.y = element_text(size = 9),
panel.grid.minor = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.major.x = element_line(colour = "grey90"),
plot.margin = margin(10, 24, 12, 24))
p
Câu lệnh: (2) Đếm số vụ n theo cặp Region × Road_Type; (3) Gộp theo Region để tính tỷ lệ; (4) Tính pct = n / tổng n trong từng Region; tạo nhãn phần trăm lbl1; (8) Khai báo bảng màu Okabe–Ito cho từng loại đường; (9) Khởi tạo biểu đồ; (10) Vẽ cột ngang (bar), ẩn legend; (11) Gắn nhãn trắng bên trong cho các cột inside; (12) Gắn nhãn đen bên ngoài cho các cột không inside; (13) Chia ô theo Region (3 cột), trục Y mỗi ô free_y; dùng nhãn VN lab_region; (14) Trục X 0→… (tự mở rộng), chia mốc 0–50% mỗi 10%, hiển thị dạng %; thêm đệm; (15) Không cắt chữ tràn khỏi panel (clip = “off”).
Nhận xét: Biểu đồ cho thấy sự khác biệt rõ giữa các vùng. Miền Nam có tỷ lệ tai nạn trên đường nội bộ cao nhất (48,7%), phản ánh đặc trưng đô thị hóa rộng và lưu lượng nội vùng lớn. Miền Tây và Đông Bắc có cơ cấu cân bằng hơn, trong đó cao tốc chiếm 22–25%, phù hợp với đặc điểm giao thông liên đô thị. Miền Trung Tây nổi bật với tỷ lệ cao tốc cao nhất (38,7%), thể hiện đặc trưng vùng công–nông nghiệp có nhiều tuyến vận tải xuyên bang. Vùng khác có tỷ lệ cao tốc cao nhất (43,4%), gợi ý khu vực thưa dân, hành trình dài. Nhìn chung, tai nạn tập trung ở khu vực đô thị và nội vùng, trong khi các vùng ít dân lại có xu hướng xảy ra nhiều hơn trên cao tốc.
1.4.1.4 Không gian tần suất và mức độ nghiêm trọng tai nạn (3D)
state_centers_lookup <- tibble(State = state.abb,lon = state.center$x,lat = state.center$y)
accident_summary_by_state <- US %>%
group_by(State) %>%
summarise(So_luong = n(),Severity_TrungBinh = mean(Severity, na.rm = TRUE),.groups = "drop")
bubble_data <- accident_summary_by_state %>%inner_join(state_centers_lookup, by = "State") %>%
filter(!is.na(lon), !is.na(lat)) %>%
mutate(label_html = paste0("<strong>Bang:</strong> ", State, "<br/>", "<strong>Số lượng vụ:</strong> ", comma(So_luong), "<br/>", "<strong>Severity TB:</strong> ", round(Severity_TrungBinh, 2)) |> lapply(HTML),scaled_radius = scales::rescale(sqrt(So_luong), to = c(4, 25)))
color_palette <- colorNumeric( palette = "inferno",domain = bubble_data$Severity_TrungBinh)
if (knitr::is_html_output()) {leaflet(data = bubble_data, width = 960, height = 600) %>%
addProviderTiles(providers$CartoDB.DarkMatter, group = "Nền tối") %>%
addProviderTiles(providers$CartoDB.Positron, group = "Nền sáng") %>%
addCircleMarkers( lng = ~lon, lat = ~lat, radius = ~scaled_radius, color = ~color_palette(Severity_TrungBinh), fillColor = ~color_palette(Severity_TrungBinh), weight = 1, opacity = 1, fillOpacity = 0.7,popup = ~label_html, label = ~State) %>%
addLegend("bottomright", pal = color_palette,values = ~Severity_TrungBinh,title = "Severity trung bình") %>%
addLayersControl(baseGroups = c("Nền tối", "Nền sáng"),options = layersControlOptions(collapsed = FALSE))} else {
m <- leaflet(bubble_data, width = 960, height = 600) %>%
addProviderTiles(providers$CartoDB.Positron) %>%
addCircleMarkers(lng = ~lon, lat = ~lat,radius = ~scaled_radius,color = ~color_palette(Severity_TrungBinh),fillColor = ~color_palette(Severity_TrungBinh),weight = 1, opacity = 1, fillOpacity = 0.7,popup = ~label_html, label = ~State) %>%
addLegend("bottomright", pal = color_palette,values = ~Severity_TrungBinh,title = "Severity trung bình")
htmlwidgets::saveWidget(m, "tmp_leaflet.html", selfcontained = TRUE)
webshot2::webshot("tmp_leaflet.html", "map_severity.png",vwidth = 960, vheight = 600)
knitr::include_graphics("map_severity.png")}Câu lệnh: (1) Tạo bảng trung tâm mỗi bang của Mỹ gồm mã bang (state.abb), kinh độ và vĩ độ; (2–4) Gom nhóm dữ liệu tai nạn theo bang, tính tổng số vụ và mức độ nghiêm trọng trung bình (Severity trung bình); (5–6) Ghép kết quả với vị trí trung tâm bang, loại bỏ các giá trị bị thiếu kinh độ/vĩ độ; (7) Tạo chuỗi HTML popup chứa tên bang, số vụ và mức độ nghiêm trọng trung bình để hiển thị khi người dùng click vào bong bóng; (8) Chuẩn hóa bán kính bong bóng theo căn bậc hai của số vụ (cho dễ nhìn); (9) Đặt thang màu Inferno để tô màu bong bóng theo giá trị severity trung bình.
Nhận xét:
Các bong bóng lớn tập trung tại các bang đông dân, đô thị hóa cao như California (CA), Texas (TX) và Florida (FL) — nơi có lưu lượng giao thông, hoạt động kinh tế, và số điểm giao cắt lớn, dẫn đến tần suất tai nạn cao. Tuy nhiên, nhờ hạ tầng và hệ thống cấp cứu tốt, mức độ nghiêm trọng trung bình (Severity TB) ở đây lại thấp hơn.
Ở các bang nông thôn (rural), dù số vụ ít hơn, mức nghiêm trọng trung bình cao hơn do đường tốc độ cao, cấp cứu chậm, thắt dây an toàn ít phổ biến, và tỷ lệ xe tải lớn cao.
Khí hậu và mùa vụ cũng ảnh hưởng: vùng Bắc/Đông Bắc (băng tuyết, sương mù) dễ có va chạm nặng, trong khi bang nóng dễ xảy ra mệt mỏi, giảm tập trung.
1.4.1.5 Mật độ tai nạn theo toạ độ
us_map <- rnaturalearth::ne_states("United States of America", returnclass = "sf")
pts <- Acc %>%transmute(lng = suppressWarnings(as.numeric(gsub(",", ".", as.character(lon)))),lat = suppressWarnings(as.numeric(gsub(",", ".", as.character(lat))))) %>%
filter(is.finite(lng), is.finite(lat))
ggplot() +
geom_sf(data = us_map, fill = "gray90", color = "gray60", linewidth = 0.2) +
geom_hex(data = pts, aes(x = lng, y = lat), bins = 80, inherit.aes = FALSE) +
coord_sf(xlim = c(-125, -65), ylim = c(25, 50)) +
scale_fill_viridis_c(option = "C", name = "Mật độ") +
labs(title = "PHÂN BỐ ĐỊA LÝ CỦA CÁC VỤ TAI NẠN TẠI HOA KỲ",subtitle = "Hexbin cho thấy các cụm mật độ tai nạn",x = "Kinh độ", y = "Vĩ độ") +
theme_minimal() + theme_minimal(base_family = "Times New Roman") +
theme(plot.title = element_text(face = "bold", hjust = .5, size = 12),
plot.subtitle = element_text(hjust = .5, size = 10, color = "gray50"),
axis.text = element_blank(), axis.ticks = element_blank(),
panel.grid.major = element_line(color = "gray95", linewidth = .2))
Câu lệnh: (1) lấy dữ liệu bản đồ các bang Mỹ; (2) chuyển đổi kinh độ, vĩ độ sang số và loại bỏ giá trị lỗi; (4–5) vẽ bản đồ nền và lớp hexbin biểu thị mật độ tai nạn; (6) cố định phạm vi hiển thị bản đồ; (7) tô màu theo mật độ (viridis); (8–9) đặt tiêu đề, phụ đề, trục tọa độ; (10–14) áp dụng theme Times New Roman, căn giữa tiêu đề, đơn giản hóa nền và lưới.
Nhận xét:
Mật độ cao tập trung dọc Bờ Đông (I-95 corridor) từ Boston – New York – Philadelphia – Washington, D.C., cùng vành đai Ngũ Đại Hồ (Chicago – Detroit – Cleveland), phản ánh đô thị hóa cao, lưu lượng lớn và nhiều điểm giao cắt.
Trên Bờ Tây, nổi bật là hành lang California (Bay Area – Los Angeles – San Diego) và trục I-5, cùng các cụm Phoenix và Las Vegas. Texas tạo thành tam giác đô thị DFW – Houston – San Antonio/Austin, khu vực có mạng cao tốc dày và dân số lớn. Ngược lại, vùng Núi non – Đồng bằng liên sơn (Montana, Wyoming, Idaho, Utah, New Mexico) có mật độ thấp, phù hợp với đặc điểm dân cư thưa và ít tuyến đường lớn.
1.4.2 Thời gian
1.4.2.1 Phân phối tai nạn theo mùa
acc2 <- Acc %>%transmute(lng = suppressWarnings(as.numeric(gsub(",", ".", as.character(lon)))),
lat = suppressWarnings(as.numeric(gsub(",", ".", as.character(lat)))),
Season = case_when( Season %in% c("Winter","Đông") ~ "Mùa Đông",Season %in% c("Spring","Xuân") ~ "Mùa Xuân",Season %in% c("Summer","Hè") ~ "Mùa Hè",Season %in% c("Fall","Autumn","Thu") ~ "Mùa Thu",TRUE ~ as.character(Season))) %>%
filter(is.finite(lng), is.finite(lat), !is.na(Season)) %>%
mutate(Season = factor(Season, levels = c("Mùa Đông","Mùa Xuân","Mùa Hè","Mùa Thu")))
usa <- map_data("state")
bins_hex <- 60
ggplot() +
geom_polygon(data = usa,aes(long, lat, group = group),fill = "#333333", color = "#555555", linewidth = 0.1) +
geom_hex(data = acc2,aes(lng, lat, fill = after_stat(count)), bins = bins_hex, inherit.aes = FALSE) +
coord_map("albers", lat0 = 39, lat1 = 45) +
facet_wrap(~ Season, ncol = 2) +
scale_fill_viridis_c( option = "C", name = "Mật độ (số vụ/ô hex)",labels = scales::comma_format(big.mark = ".", decimal.mark = ","),
guide = guide_colorbar(barheight = unit(90, "pt"),barwidth = unit(16, "pt"),ticks.colour = "white",title.position = "top",title.hjust = 0.5)) +
labs(title = "PHÂN BỐ TAI NẠN THEO MÙA (Hexbin)",subtitle = "Màu càng sáng = càng nhiều vụ tai nạn trong mỗi ô lục giác",caption = paste0("Lưới hex: bins = ", bins_hex," · Phép chiếu: Albers · Nền: biên giới bang (maps::state)")) +
theme_void(base_size = 12) +
theme(plot.background = element_rect(fill = "#0f0f0f", color = NA), panel.background = element_rect(fill = "#0f0f0f", color = NA),strip.text = element_text(face = "bold", size = 12, color = "white"),plot.title = element_text(face = "bold", size = 16, hjust = .5, color = "white"), plot.subtitle = element_text(size = 8, hjust = .5, color = "grey80", margin = margin(b = 6)),plot.caption = element_text(size = 8, color = "grey70", margin = margin(t = 6)),legend.position = "right",legend.text = element_text(color = "white"),legend.title = element_text(color = "white", face = "bold"), legend.background= element_rect(fill = NA, color = NA))
Câu lệnh: (1–3) chuyển kinh độ, vĩ độ sang số; gộp mùa (Đông, Xuân, Hè, Thu); (4–6) lọc giá trị hợp lệ, định dạng thứ tự mùa; (7) đặt số ô hex = 60; (9–10) vẽ bản đồ bang nền tối và lớp hexbin mật độ tai nạn; (11–12) dùng phép chiếu Albers, chia 4 biểu đồ theo mùa; (13–14) tô màu theo mật độ, chỉnh thanh chú giải; (15) đặt tiêu đề, phụ đề, ghi chú; (16–17) theme nền tối, font Times New Roman, chữ và chú thích màu trắng.
Nhận xét: Mùa đông, bờ Đông I-95 và vành đai Ngũ Đại Hồ nổi bật hơn do băng tuyết, tầm nhìn kém, đường trơn; vùng núi–đồng bằng thưa điểm. Mùa xuân, cụm đô thị giữ nguyên, lan nhẹ ra ngoại ô; thời tiết chuyển mùa (mưa, sương) làm rủi ro tăng ở Trung–Đông Nam. Mùa hè, nổi bật tại California (Bay Area–LA–San Diego), Texas (DFW–Houston–San Antonio/Austin), Florida, và Las Vegas–Phoenix do du lịch, hoạt động đêm. Mùa thu, lắng nhẹ so với Hè nhưng các trục chính (I-95, California, Texas) vẫn duy trì; Trung Tây tập trung quanh cực đô thị.
1.4.2.2 Xu hướng tai nạn theo giờ
hour_df <- Acc %>%transmute(Start_Hour = as.integer(Start_Hour)) %>%filter(!is.na(Start_Hour), between(Start_Hour, 0, 23)) %>%
count(Start_Hour, name = "Count") %>%tidyr::complete(Start_Hour = 0:23, fill = list(Count = 0)) %>%
arrange(Start_Hour)
max_y <- max(hour_df$Count) * 1.15
bands <- hour_df %>%mutate(x_id = as.numeric(factor(Start_Hour, levels = 0:23)),xmin = x_id - 0.5, xmax = x_id + 0.5,ymin = 0, ymax = max_y,is_band = Start_Hour %% 2 == 0) %>%
filter(is_band) %>%dplyr::select(xmin, xmax, ymin, ymax)
p_max <- hour_df %>% slice_max(Count, n = 1, with_ties = FALSE)
p_min <- hour_df %>% slice_min(Count, n = 1, with_ties = FALSE)
p_radial <- ggplot() +
geom_rect(data = bands,aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax),fill = "#fff2cc", alpha = .35, inherit.aes = FALSE) +
geom_hline(yintercept = pretty(hour_df$Count, 4),color = "grey90", linewidth = .3) +
geom_col(data = hour_df,aes(x = as.numeric(factor(Start_Hour, levels = 0:23)), y = Count, fill = Count), width = .92, color = "white", linewidth = .25) +
scale_fill_gradient(low = "#9ec5fe", high = "#1e40af", guide = "none") +
geom_point(data = p_max,aes(x = as.numeric(factor(Start_Hour, levels = 0:23)), y = Count),color = "#16a34a", size = 2.8) +
geom_point(data = p_min,aes(x = as.numeric(factor(Start_Hour, levels = 0:23)), y = Count), color = "#ef4444", size = 2.8) +
geom_label_repel(data = p_max,aes(x = as.numeric(factor(Start_Hour, levels = 0:23)), y = Count,
label = paste0("ĐỈNH ", Start_Hour, "h\n",number(Count, big.mark = ".", decimal.mark = ","), " vụ")), seed = 1, nudge_y = max(hour_df$Count)*.30, nudge_x = .35,
label.size = 0, fill = "#e8f5e9", color = "#166534", size = 3.2, fontface = "bold",
segment.colour = "#16a34a", segment.size = .4, box.padding = .4, min.segment.length = .5) +
geom_label_repel(data = p_min,aes(x = as.numeric(factor(Start_Hour, levels = 0:23)), y = Count,
label = paste0("ĐÁY ", Start_Hour, "h\n",number(Count, big.mark = ".", decimal.mark = ","), " vụ")),seed = 2, nudge_y = max(hour_df$Count)*.22, nudge_x = -.35,label.size = 0, fill = "#fee2e2", color = "#991b1b", size = 3.2, fontface = "bold",segment.colour = "#ef4444", segment.size = .4, box.padding = .4, min.segment.length = .4) +
coord_polar(start = -pi/24, clip = "off") +
scale_x_continuous(breaks = seq(0, 23, 3), labels = paste0(seq(0,23,3),"h"),expand = expansion(add = .6)) +
scale_y_continuous(labels = label_number(big.mark=".", decimal.mark=","), expand = expansion(mult = c(0, .20))) +
labs(title = "XU HƯỚNG TAI NẠN THEO GIỜ") +
theme_minimal(base_family = "Times New Roman", base_size = 12) +
theme(legend.position="none", panel.grid.minor=element_blank(),
axis.text.y=element_blank(), axis.title=element_blank(),
plot.title=element_text(size=16, hjust=.5))
top6 <- hour_df %>% slice_max(Count, n = 6) %>% arrange(desc(Count)) %>%
mutate(lbl1 = paste0(number(Count, big.mark=".", decimal.mark=","), " vụ"))
max_x <- max(top6$Count) * 1.25
p_top <- ggplot(top6, aes(x = Count, y = reorder(paste0(Start_Hour,"h"), Count))) +
geom_col(fill = "#2563eb", alpha = .9, width = .6) +
geom_label(aes(label = lbl1, x = Count*1.01), hjust=0, label.size=0,
label.padding = grid::unit(0.12,"lines"),
fill="white", color="#0f172a", size=3.2, fontface="bold") +
coord_cartesian(clip="off", xlim=c(0, max_x)) +
scale_x_continuous(labels = label_number(big.mark=".", decimal.mark=","), expand = expansion(mult = c(0,.01))) +
labs(title="Top 6 giờ có số vụ cao nhất)", x="Số vụ", y=NULL) +
theme_minimal(base_family="Times New Roman", base_size=12) +
theme(plot.title=element_text(face="bold", size=12, color="#1f2937"),
panel.grid.minor=element_blank(),
panel.grid.major=element_line(colour="grey90"),
plot.margin=margin(t=5, r=30, b=5, l=5))
p_radial / p_top + patchwork::plot_layout(heights = c(5,1))
Câu lệnh: (1) Lấy giờ bắt đầu tai nạn (Start_Hour), lọc giá trị hợp lệ (0–23); (2) Đếm số vụ tai nạn theo từng giờ; (3) Tạo cột liên tục 0–23 (đảm bảo đủ 24 giờ); (4) Xác định giá trị cao nhất (max) và thấp nhất (min) của số vụ; (5) Tạo khung dữ liệu phục vụ vẽ nền xen kẽ (band sáng/tối mỗi 2 giờ); (6) Vẽ biểu đồ radar hình tròn (coord_polar) với số vụ theo giờ; (12) Cấu hình trục góc (0–23h), định dạng số có dấu phẩy; (13) Tiêu đề “Xu hướng tai nạn theo giờ”, font Times New Roman; (14) Biểu đồ phụ (p_top): lấy 6 giờ có số vụ cao nhất, vẽ biểu đồ cột ngang màu xanh lam.
Nhận xét: Biểu đồ cho thấy tai nạn tập trung nhiều vào buổi chiều, đạt đỉnh lúc 16h với gần 150.000 vụ, trùng với thời điểm tan ca, lưu lượng giao thông cao. Các khung 15–18h là khoảng rủi ro cao nhất trong ngày. Ngược lại, đáy 3h sáng (18.387 vụ) thể hiện thời gian ít phương tiện lưu thông nhất. Số vụ bắt đầu tăng từ sáng sớm, duy trì cao suốt ngày và giảm dần sau 19h. Mẫu hình này phản ánh rõ tác động của thói quen di chuyển giờ cao điểm và mức độ hoạt động kinh tế – xã hội trong ngày đến rủi ro tai nạn.
1.4.2.3 Phân bố tần suất tai nạn theo tháng
month_counts <- Acc %>%count(Start_Month)
ggplot(month_counts, aes(x = factor(Start_Month), y = n)) +
geom_col(fill = "#2a9d8f", width = 0.7) +
scale_x_discrete(labels = month.abb) +
scale_y_continuous(labels = scales::number_format(big.mark = ".")) +
labs(title = "XU HƯỚNG TAI NẠN THEO THÁNG",x = "Tháng",y = "Số Vụ Tai Nạn") +
theme_minimal(base_family = "Times New Roman", base_size = 14) +
theme(plot.title = element_text(face = "bold", hjust = 0.5, size = 18))
Câu lệnh: (1) Đếm số vụ theo tháng bắt đầu; (2) Khởi tạo biểu đồ từ bảng đếm; (3) Vẽ cột (màu xanh, rộng 0,7); (4) Đặt nhãn trục X bằng viết tắt tháng; (5) Định dạng trục Y có dấu chấm ngăn cách; (6) Thêm tiêu đề và nhãn trục; (7) Áp theme Times New Roman; (8) Tiêu đề in đậm, căn giữa, cỡ 18.
Nhận xét: Biểu đồ “Xu hướng tai nạn theo tháng” cho thấy tần suất tai nạn giao thông ở Hoa Kỳ dao động rõ rệt theo mùa. Tai nạn tăng mạnh vào tháng 4 và tháng 12, trong khi tháng 10 thấp nhất, phản ánh ảnh hưởng kết hợp của thời tiết, hành vi di chuyển và yếu tố xã hội – kinh tế. Tháng 4 là giai đoạn du lịch, lễ hội, Spring Break, lưu lượng phương tiện cao → nhiều va chạm hơn. Tháng 12 trùng mùa Giáng sinh và năm mới, nhu cầu di chuyển và mua sắm tăng → rủi ro giao thông cao. Ngược lại, tháng 10 là giai đoạn ổn định, lưu lượng thấp → ít tai nạn hơn. Về điều kiện tự nhiên, mùa đông – đầu xuân dễ có mưa, tuyết, sương mù làm giảm tầm nhìn; mùa hè nóng, dễ gây mệt mỏi, chủ quan khi lái xe, nên tần suất tai nạn cũng tăng.
1.4.2.4 Biến động số vụ tai nạn theo dòng thời gian
daily_counts <- Acc %>%
mutate(Date = as_date(Date)) %>% count(Date)
ggplot(daily_counts, aes(x = Date, y = n)) +
geom_line(color = "#1f77b4", linewidth = 0.5, alpha = 0.8) +
geom_smooth(method = "loess", span = 0.1, color = "red", se = FALSE, linewidth = 1) +
scale_y_continuous(labels = scales::number_format(big.mark = ".")) +
scale_x_date(date_labels = "%Y-%m", date_breaks = "3 months") +
labs(title = "XU HƯỚNG TAI NẠN THEO DÒNG THỜI GIAN",x = "Thời gian", y = "Số Vụ Tai Nạn") +
theme_minimal(base_family = "Times New Roman", base_size = 10) +
theme(plot.title = element_text(face = "bold", hjust = 0.5, size = 14),
axis.text.x = element_text(angle = 45, hjust = 1))
Câu lệnh: (2) Ép Date về kiểu ngày và đếm số vụ theo ngày; (3) Khởi tạo ggplot: trục X = ngày, Y = số vụ n; (4) Vẽ đường thời gian màu xanh; (5) Thêm đường xu hướng LOESS (đỏ), không hiển thị dải SE; (6) Định dạng trục Y có dấu phân cách hàng nghìn “.”; (7) Trục X hiển thị nhãn YYYY-MM, cách nhau 3 tháng.
Nhận xét: Biểu đồ cho thấy số vụ tai nạn biến động theo chu kỳ, với dao động ngắn hạn lặp lại hàng tuần (đường xanh) và xu hướng tổng thể ổn định (đường đỏ LOESS). Một số đỉnh rõ rệt xuất hiện vào các giai đoạn tháng 3, tháng 7 và cuối năm, có thể trùng với cao điểm du lịch, nghỉ lễ hoặc thời tiết bất lợi. Giữa năm (khoảng tháng 6–9) có xu hướng giảm nhẹ, phản ánh giai đoạn giao thông ổn định hơn. Tổng thể, xu hướng năm 2022 cho thấy biến động tuần hoàn mạnh nhưng không có xu hướng tăng hoặc giảm dài hạn rõ rệt.
1.4.2.5 Phân bố tai nạn theo giờ và ngày trong tuần
hour_wday_data <- Acc %>% mutate(Date = as_date(Date),Wday = wday(Date, label = TRUE, week_start = 1, abbr = FALSE)) %>%count(Start_Hour, Wday)
ggplot(hour_wday_data, aes(x = Start_Hour, y = Wday)) +
geom_point(aes(size = n, color = n), alpha = 0.8) +
scale_color_viridis_c(option = "plasma",name = "Số vụ",labels = scales::number_format(big.mark = ".")) +
scale_size_area( max_size = 12,name = "Số vụ",labels = scales::number_format(big.mark = ".")) +
scale_x_continuous(breaks = seq(0, 23, by = 2), expand = expansion(add = 0.5)) +
labs(title = "PHÂN BỐ TAI NẠN THEO GIỜ VÀ NGÀY TRONG TUẦN",x = "Giờ trong Ngày",y = "Ngày trong Tuần") +
theme_minimal(base_family = "Times New Roman", base_size = 10) +
theme(plot.title = element_text(face = "bold", hjust = 0.5, size = 14),
panel.grid.minor = element_blank(),
panel.grid.major.x = element_line(color = "grey90", linewidth = 0.3),
axis.text.x = element_text(angle = 45, hjust = 1))
Câu lệnh: (1) tạo bảng đếm số vụ theo giờ (Start_Hour) và ngày trong tuần (Wday); (2–3) vẽ biểu đồ điểm thể hiện số vụ theo 2 trục giờ–ngày; (4–5) tô màu và kích thước điểm theo số vụ, dùng thang plasma; (6) chia trục giờ từ 0–23 (cách 2 giờ); (7) đặt tiêu đề, nhãn trục; (8–12) theme Times New Roman, tiêu đề in đậm, trục X xoay 45°, ẩn lưới phụ
Nhận xét:
Kết quả cho thấy hai khung giờ cao điểm nổi bật: sáng 7–9h và chiều 15–18h, khi các điểm màu vàng–cam sáng tập trung dày đặc, đặc biệt trong các ngày Thứ Ba đến Thứ Sáu. Ban đêm (0–5h), các điểm nhỏ, màu tím sẫm phản ánh số vụ rất thấp do lưu lượng giao thông giảm.
Theo ngày trong tuần, tai nạn nhiều hơn vào ngày làm việc và giảm rõ vào cuối tuần, thấp nhất vào Chủ nhật. Mẫu hình này phù hợp với hành vi di chuyển thực tế: nhiều xe trong giờ đi làm và tan tầm → rủi ro cao hơn.
1.4.3 Phân bố và thống kê
1.4.3.1 Phân bố độ ẩm
ggplot(Acc, aes(x = `Humidity(%)`)) +
geom_histogram(aes(y = ..density..), binwidth = 2, fill = "lightblue", color = "white", alpha = 0.7) +
geom_density(color = "darkblue", linewidth = 1.2) +
geom_vline(aes(xintercept = mean(`Humidity(%)`, na.rm = TRUE)), color = "red", linetype = "dashed", linewidth = 1) + labs(title = "PHÂN BỐ TẦN SUẤT CỦA ĐỘ ẨM (%)",
subtitle = "Đường đứt nét màu đỏ thể hiện giá trị trung bình",x = "Độ ẩm (%)",y = "Mật độ") +
theme_minimal(base_family = "Times New Roman", base_size = 14) +
theme(plot.title = element_text(face = "bold", hjust = 0.5, size = 14),
plot.subtitle = element_text(color = "red", hjust = 0.5, size=11))
Câu lệnh: (1–2) vẽ histogram mật độ cho biến Humidity(%), tô xanh nhạt; (3) thêm đường mật độ màu xanh đậm; (4) vẽ đường trung bình màu đỏ, nét đứt; (5–7) đặt tiêu đề, phụ đề, nhãn trục; (8–9) theme Times New Roman, tiêu đề in đậm, phụ đề màu đỏ.
Nhận xét:
Phân bố hơi lệch phải, tập trung chủ yếu trong khoảng 45–65%, đỉnh khoảng 55% gần vị trí trung bình → phân phối khá cân đối. Ở vùng trên 80%, mật độ nhỏ nhưng có vài gợn sóng, phản ánh một số quan sát trong điều kiện ẩm cao (mưa, sương). Dưới 25%, mật độ gần 0 – điều kiện quá khô hầu như không xuất hiện.
Trung bình độ ẩm trong các vụ tai nạn khoảng 55–60%, độ phân tán nhỏ → đa số tai nạn xảy ra trong điều kiện ôn hòa, ẩm vừa phải, phù hợp khí hậu nhiều bang Hoa Kỳ. Một phần nhỏ xảy ra trong môi trường ẩm ướt hơn, có thể làm tăng rủi ro do tầm nhìn giảm và đường trơn.
1.4.3.2 10 Điều kiện thời tiết phổ biến nhất
top_10_weather <- Acc %>% dplyr::filter(!is.na(Weather_Condition)) %>%
dplyr::count(Weather_Condition, name = "Count") %>%
dplyr::arrange(dplyr::desc(Count)) %>% head(10)
max_count <- max(top_10_weather$Count, na.rm = TRUE)
upper_limit <- ceiling(max_count * 1.10 / 250000) * 250000
ggplot(top_10_weather,aes(x = reorder(Weather_Condition, Count), y = Count)) +
geom_col(aes(fill = Count), width = 0.7) +
scale_fill_gradient(low = "#90B2E0", high = "#1949FC") +
geom_text(aes(label = scales::number_format(big.mark=".", decimal.mark=",")(Count)),hjust = -0.15, size = 4, color = "black", fontface = "bold") +
coord_flip(clip = "off") +
scale_y_continuous(breaks = seq(0, upper_limit, by = 250000),labels = scales::number_format(big.mark=".", decimal.mark=","), expand = ggplot2::expansion(mult = c(0, 0.30)),limits = c(0, upper_limit)) +
labs(title = "10 ĐIỀU KIỆN THỜI TIẾT CÓ TAI NẠN NHIỀU NHẤT",
subtitle = "Phân tích số vụ tai nạn theo điều kiện thời tiết phổ biến",
x = "Điều kiện Thời tiết", y = "Số Lượng Vụ Tai Nạn", fill = NULL) +
theme_minimal(base_size = 14) +
theme(plot.title = element_text(face = "bold", hjust = 0.5, size = 14, margin = margin(b = 10)),
plot.subtitle = element_text(color = "gray50", hjust = 0.2, size =10),
axis.text.x = element_text(size = 10),
axis.text.y = element_text(face = "bold", size = 11),
panel.grid.minor = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.major.x = element_line(color = "gray90", size = 0),
plot.margin = margin(t = 8, r = 40, b = 8, l = 8),
legend.position = "none")
Câu lệnh: (2) Đếm số vụ tai nạn theo từng điều kiện thời tiết, sắp xếp giảm dần và lấy 10 loại phổ biến nhất; (3) Xác định giới hạn trục Y (làm tròn lên theo bội 250.000 để dễ đọc); (4) Dựng biểu đồ cột ngang thể hiện số vụ theo từng loại thời tiết; (5) Tô màu cột bằng thang màu gradient từ xanh lam đến hồng; (6) Hiển thị nhãn số vụ ngay đầu mỗi cột, căn trái nhẹ, in đậm màu đen; (7) Dùng coord_flip() để hoán đổi trục – điều kiện thời tiết nằm trên trục tung, số vụ nằm ngang.
Nhận xét: Thời tiết “Fair” (tốt) chiếm ưu thế tuyệt đối với ~904.354 vụ, cao hơn nhiều so với các nhóm Mostly Cloudy, Cloudy, Partly Cloudy (159–228 nghìn vụ). Các điều kiện mưa, tuyết, sương mù như Light Rain, Light Snow, Fog, Rain có số vụ ít hơn hẳn. Điều này không phản ánh rủi ro cao hơn khi trời đẹp, mà cho thấy thời gian phơi nhiễm trong điều kiện này lớn hơn – nhiều ngày nắng, lưu lượng xe cao nên tổng số vụ tăng. Ngược lại, mưa hay tuyết làm giảm lưu lượng và tốc độ, nên tổng vụ ít hơn dù rủi ro cá thể có thể cao.
1.4.3.3 So sánh mức độ nghiêm trọng theo mùa
if (!exists("waffle_data")) {
waffle_data <- data.frame(
Season_Label = rep(c("Xuân","Hạ","Thu","Đông"), each = 4),
Severity = rep(c("1","2","3","4"), times = 4),
Percentage = c(18,27,35,20, 12,23,40,25, 22,28,30,20, 25,30,28,17))}
to_waffle_grid <- function(df, rows = 10) {
df <- df %>% mutate(Severity = factor(Severity, levels = c("1","2","3","4")))
df %>%
group_by(Season_Label) %>%
group_modify(function(.x, .y) {p <- .x$Percentage
if (max(p, na.rm = TRUE) <= 1) p <- p * 100
if (sum(p) > 0) p <- p / sum(p) * 100
base <- floor(p)
need <- 100 - sum(base)
frac <- p - base
if (need > 0) {idx <- order(frac, decreasing = TRUE)[seq_len(need)]
base[idx] <- base[idx] + 1}
parts <- rep(as.character(.x$Severity), times = base)
n <- length(parts); if (n == 0) return(tibble())
x <- ((seq_len(n) - 1) %% rows) + 1
y <- rows - ((seq_len(n) - 1) %/% rows)
tibble(x = x, y = y, part = factor(parts, levels = c("1","2","3","4")))}) %>%
ungroup()}
waffle_df <- to_waffle_grid(waffle_data, rows = 10)
fill_values <- c( "1" = "#EBEBEB", "2" = "#B0B0B0", "3" = "#FF7F50", "4" = "#CC0000" )
fill_breaks <- c("4","3","2","1")
fill_labels <- c("4 (Cao nhất)", "3 (Nghiêm trọng)", "2 (Trung bình)", "1 (Nhẹ nhất)")
waffle_plot <-ggplot(waffle_df, aes(x, y, fill = part)) +
geom_tile(width = 0.95, height = 0.95, color = "white", size = 1.2) +
coord_equal(expand = FALSE) +
facet_wrap(~Season_Label, nrow = 1, strip.position = "top") +
scale_fill_manual(values = fill_values, breaks = fill_breaks, labels = fill_labels, name = "MỨC ĐỘ TAI NẠN") +
labs(title = "PHÂN BỐ TỶ LỆ NGHIÊM TRỌNG TAI NẠN THEO MÙA", subtitle = "Mỗi ô vuông ≈ 1% số vụ trong mùa (Waffle 10×10)") +
theme_void(base_family = "Times New Roman") +
theme(strip.placement = "outside",strip.text = element_text(face = "bold", size = 12, margin = margin(b = 8)),strip.background = element_blank(),legend.position = "bottom",legend.title = element_text(face = "bold", hjust=0.5), plot.title = element_text(face = "bold", size = 12, hjust=0.5, margin = margin(t = 20, b = 5)), plot.subtitle = element_text(hjust = 0.5, size = 12, colour = "gray40", margin = margin(b = 15)), plot.margin = margin(30, 30, 30, 30),plot.background = element_rect(fill = "white", colour = NA))
print(waffle_plot)
Câu lệnh: (1–5) tạo bảng dữ liệu tỷ lệ mức độ nghiêm trọng theo mùa; (6–23) hàm to_waffle_grid chuyển tỷ lệ thành lưới 10×10 (mỗi ô ≈ 1%); (25–28) gán màu cho 4 mức độ: từ xám nhạt (nhẹ) đến đỏ (cao nhất); (29–33) vẽ biểu đồ waffle, chia theo mùa, tô màu theo mức độ; (34) đặt tiêu đề, phụ đề, chú thích; (35–36) theme Times New Roman, tiêu đề in đậm, chú thích dưới cùng.
Nhận xét: Mùa Hạ có tỷ lệ tai nạn nặng cao nhất (65%), kế đến là Xuân (55%), Thu (50%) và Đông thấp nhất (45%). Điều này cho thấy mẫu hình mùa vụ rõ rệt: mùa Hạ tai nạn nghiêm trọng hơn do lưu lượng du lịch và vận tải cao, tốc độ lớn, trong khi mùa Đông nhẹ hơn nhờ di chuyển chậm và thận trọng hơn.
1.4.3.4 Phân bố tần suất tai nạn theo phạm vi ảnh hưởng
heatmap_data <- Acc %>%filter(!is.na(Duration_Bin), !is.na(Severity)) %>%
count(Duration_Bin, Severity) %>%
group_by(Duration_Bin) %>%
mutate(Percentage = n / sum(n)) %>%
ungroup()
ggplot(heatmap_data, aes(x = Duration_Bin, y = factor(Severity), fill = Percentage)) +
geom_tile(color = "white", linewidth = 1) +
geom_text(aes(label = scales::label_percent(big.mark = ".", decimal.mark = ",", accuracy = 0.1)(Percentage),color = ifelse(Percentage > 0.60, "black", "white")),fontface = "bold", size = 4) +
scale_fill_viridis_c(option = "magma",name = "Tỷ lệ %",labels = scales::label_percent(big.mark = ".", decimal.mark = ","), guide = guide_colorbar(title.position = "top", barwidth = unit(6, "cm"),barheight = unit(0.45, "cm"),ticks = FALSE)) +
scale_color_manual(values = c("black" = "black", "white" = "white"), guide = "none") +
labs(title = "MỨC ĐỘ NGHIÊM TRỌNG THEO THỜI GIAN TAI NẠN",subtitle = "Sử dụng Biểu đồ Nhiệt (Heatmap) để so sánh tỷ lệ",x = "Khoảng thời gian tai nạn (đã phân loại)",y = "Mức độ Nghiêm trọng") +
theme_minimal(base_family = "Times New Roman", base_size = 14) +
theme(plot.title = element_text(face = "bold", hjust = 0.5, size = 14),plot.subtitle = element_text(hjust = 0.5, color = "gray50", size = 12),panel.grid = element_blank(),legend.position = "bottom",legend.title = element_text(margin = margin(b = 2)), legend.box.margin = margin(t = -4),axis.title.x = element_text(hjust = 0.5, margin = margin(t = 12), face = "bold" ),axis.text.x = element_text(angle = 45, hjust = 1, face = "bold"), axis.text.y = element_text(face = "bold"), axis.title.y = element_text(face = "bold"))
Câu lệnh: (2) Đếm số vụ theo cặp Duration_Bin × Severity; (3) Gộp theo Duration_Bin để tính tỷ lệ trong mỗi hàng; (4) Bỏ group để vẽ; (6) Khởi tạo heatmap: trục X = Duration_Bin, trục Y = Severity, fill = Percentage; (7) Vẽ ô vuông viền trắng; (8) Gắn nhãn phần trăm trong từng ô; chữ đen/trắng tùy ngưỡng 60%; (9) Thang màu viridis (magma) cho tỷ lệ; thanh màu đặt trên.
Nhận xét:
Biểu đồ nhiệt (heatmap) cho thấy mức độ nghiêm trọng cấp 2 chiếm ưu thế tuyệt đối trong mọi khoảng thời gian (≈73–96%), trong khi cấp 1 và cấp 4 luôn rất thấp (<10% và <4%). Cấp 3 xuất hiện đáng kể ở thời gian ngắn (≤60 phút, ~14–16%) nhưng giảm mạnh khi thời gian tăng (>60 phút, chỉ còn ~1–2%).
Tỷ lệ cấp 2 tăng dần sau mốc 60 phút, đạt đỉnh ~96% ở khoảng 76–90 phút, cho thấy phần lớn sự cố thuộc nhóm trung bình và ổn định theo thời gian. Việc chuẩn hóa theo cột khiến không thể so sánh quy mô tuyệt đối giữa các nhóm thời gian, chỉ thể hiện cơ cấu phần trăm.
Các vụ kéo dài thường vẫn ở mức nghiêm trọng trung bình, gợi ý hệ thống cứu hộ hoạt động hiệu quả, giúp hạn chế diễn biến nặng. Ngược lại, các vụ ngắn hơn (≤45 phút) có tỷ lệ cấp 3–4 cao hơn, phản ánh khả năng va chạm mạnh trong môi trường tốc độ cao hoặc đông đúc.
1.4.3.5 Phân bố tần suất tai nạn theo hướng di chuyển
direction_counts <- Acc %>%filter(!is.na(Direction), Direction != "Không rõ/Khác") %>%
count(Direction)
ggplot(direction_counts, aes(x = reorder(Direction, n), y = n)) +
geom_col(fill = "#e76f51", width = 0.7) +
geom_text(aes(label = scales::number_format(big.mark = ".")(n)),hjust = 1.1,color = "white",
fontface = "bold",size = 4) +
coord_flip() +
scale_y_continuous(labels = scales::number_format(big.mark = ".")) +
labs(title = "SỐ VỤ TAI NẠN THEO HƯỚNG DI CHUYỂN",x = "Hướng",y = "Số Vụ Tai Nạn") +
theme_minimal(base_family = "Times New Roman", base_size = 14) +
theme(plot.title = element_text(face = "bold", hjust = 0.5, size = 11))
Câu lệnh: (1) lọc bỏ giá trị NA và nhóm “Không rõ/Khác” rồi đếm số vụ theo hướng; (2–4) vẽ biểu đồ cột ngang, màu cam; (5) thêm nhãn số vụ, chữ trắng, in đậm; (7) lật trục hoành–tung để dễ đọc; (8–10) định dạng trục, tiêu đề, font Times New Roman, tiêu đề in đậm căn giữa.
Nhận xét:
Hướng Nam (South) có số vụ tai nạn cao nhất (~235.820), kế đến hướng Bắc (North) (~225.971). Hai hướng Tây (West) và Đông (East) thấp hơn rõ rệt (~177.000 và ~173.000). Cấu trúc này cho thấy sự phân bố không đồng đều theo hướng di chuyển. Các trục Nam–Bắc thường là tuyến chính qua khu dân cư và trung tâm đô thị, lưu lượng lớn → rủi ro va chạm cao hơn.
Tai nạn tập trung ở hướng Nam–Bắc, phản ánh mối liên hệ giữa mật độ dân cư, hoạt động kinh tế và thói quen di chuyển. Điều này gợi ý cần quy hoạch hạ tầng, phân luồng và kiểm soát giao thông hiệu quả hơn trên các tuyến chính.
1.4.3.6 Phân bố Khoảng cách theo Loại đường
ggplot(Acc, aes(x = Road_Type, y = `Distance(mi)`, fill = Road_Type)) +
geom_boxplot(alpha = 0.8, outlier.shape = NA) +
coord_cartesian(ylim = c(0, quantile(Acc$`Distance(mi)`, 0.99, na.rm = TRUE))) +
scale_fill_viridis_d(option = "mako") +
labs(title = "PHÂN BỐ CHIỀU DÀI ẢNH HƯỞNG THEO LOẠI ĐƯỜNG",x = "Loại Đường", y = "Chiều dài ảnh hưởng (dặm)") +
theme_minimal(base_family = "Times New Roman", base_size = 10) +
theme(plot.title = element_text(face = "bold", hjust = 0.5, size = 14),
axis.text.x = element_text(angle = 45, hjust = 1, face="bold"),
legend.position = "none")
Câu lệnh: (1–2) vẽ boxplot biểu diễn phân bố Distance(mi) theo Road_Type; (3) giới hạn trục tung trong khoảng 0–99% để bỏ ngoại lệ; (4) tô màu theo loại đường bằng palette mako; (5) đặt tiêu đề, nhãn trục; (6–8) dùng theme Times New Roman, tiêu đề in đậm, trục X xoay 45°; (9) ẩn chú giải (legend).
Nhận xét:
Biểu đồ hộp cho thấy đường cao tốc (Highway) có trung vị (median) và IQR (khoảng tứ phân vị) lớn nhất, phản ánh mức biến thiên cao – nhiều vụ tai nạn có phạm vi ảnh hưởng dài hơn hẳn các loại đường khác. Quốc lộ (US Route) xếp sau, còn đường nội bộ (Urban street) có trung vị thấp và phân tán nhỏ, cho thấy phạm vi ảnh hưởng ngắn và ổn định. Nhóm Khác (Other roads) nằm giữa nhưng thấp đáng kể so với cao tốc.
Về nguyên nhân, cao tốc có tốc độ cao, nút giao thưa nên khi xảy ra sự cố dễ tạo vùng phong tỏa dài; đường nội bộ có mật độ giao thông và lực lượng cứu hộ cao → phạm vi ngắn hơn; quốc lộ ở mức trung gian do đặc thù liên vùng.
1.4.3.7 Biểu đồ phân tán thời lượng và phạm vi ảnh hưởng
ggplot(correlation_data, aes(x = log_Distance, y = log_Duration)) +
stat_binhex(bins = 35) +
geom_smooth(method = "gam", formula = y ~ s(x, k = 5),linewidth = 1.2, color = "#E24A3B", se = FALSE) +
scale_fill_viridis_c(name = "Mật độ",option = "C",labels = label_number(accuracy = 1, big.mark = ".", decimal.mark = ",")) +
labs(title = "BIỂU ĐỒ PHÂN TÁN THỜI LƯỢNG VÀ PHẠM VI ẢNH HƯỞNG",x = "Phạm vi ảnh hưởng (Distance) [log(x+1)]",y = "Thời lượng xử lý (Duration) [log(x+1)]") +
theme_minimal(base_family = "Times New Roman") +
theme(plot.title = element_text(sizw = 11 , face = "bold", hjust = 0.8))
Câu lệnh: (1–2) tạo biểu đồ hexbin giữa log(Duration) và log(Distance); (3) thêm đường xu hướng GAM (màu đỏ, độ dày 1.2); (4) tô màu theo mật độ bằng thang viridis; (5) đặt tiêu đề, nhãn trục; (6–7) dùng theme Times New Roman, tiêu đề in đậm căn giữa.
Nhận xét:
Bản đồ lục giác cho thấy mật độ cao ở góc trái-dưới, tức phần lớn sự cố có phạm vi (Distance – khoảng cách ảnh hưởng) và thời lượng (Duration) ngắn. Khi Distance tăng, điểm thưa dần, cho thấy các vụ có ảnh hưởng lớn hiếm gặp.
Đường GAM (Generalized Additive Model – mô hình cộng tuyến tổng quát) biểu thị quan hệ phi tuyến: ở phạm vi nhỏ, Duration gần như ổn định; khi phạm vi lớn hơn, thời gian xử lý tăng nhanh do công tác điều phối, phong tỏa và thu dọn phức tạp hơn. Phân phối lệch và đuôi dài cho thấy việc dùng biến đổi log (log-transform) là cần thiết. Trong thực tế, sự cố nhỏ được xử lý nhanh, còn sự cố lan rộng khiến chi phí thời gian tăng mạnh.
1.4.4 Mối quan hệ giữa các biến
1.4.4.1 Mối quan hệ mùa và nhiệt độ
ggplot(Acc, aes(x = Season, y = `Temperature(F)`)) +
stat_bin_2d(bins = 60, aes(fill = after_stat(count))) +
geom_density_2d(color = "white", alpha = 0.6, linewidth = 0.3) +
scale_fill_viridis_c(option = "viridis", name = "Mật độ\nđiểm", labels = scales::label_number(big.mark = ".")) +
coord_cartesian(ylim = c(quantile(Acc$`Temperature(F)`, 0.01, na.rm = TRUE),quantile(Acc$`Temperature(F)`, 0.99, na.rm = TRUE))) +
labs(title = "MỐI TƯƠNG QUAN MẬT ĐỘ GIỮA MÙA VÀ NHIỆT ĐỘ",x = "Mùa (Season)", y = "Nhiệt độ (°F)") +
theme_minimal(base_family = "Times New Roman", base_size = 14) +
theme(plot.title = element_text(face = "bold", hjust = 0.5, size = 12, color = "black"),panel.background = element_rect(fill = "#440154FF", color = NA),plot.background = element_rect(fill = "white", color = NA),plot.subtitle = element_text(hjust = 0.5))
Câu lệnh: (1) Tạo plot: trục X = Season, trục Y = Temperature(F); (2) Vẽ heatmap 2D; (3) Chồng đường đẳng mật độ (contour) màu trắng, nhẹ; (4) Thang màu viridis, đặt tên chú giải “Mật độ điểm”, định dạng số có dấu “.”; (5) Giới hạn trục Y theo 1%–99% nhiệt độ (cắt ngoại lệ); (6) Đặt tiêu đề + nhãn trục; (7) Theme tối giản, font Times New Romam; (8) Tùy biến: tiêu đề đậm, căn giữa; nền panel tím đậm; nền biểu đồ trắng; phụ đề căn giữa.
Nhận xét: Biểu đồ cho thấy sự khác biệt rõ rệt về nhiệt độ giữa các mùa. Mùa Hè có mật độ điểm cao nhất, tập trung quanh 75–85°F, thể hiện đặc trưng thời tiết nóng và ổn định. Mùa Xuân và Mùa Thu có phân bố nhiệt độ trung bình hơn, chủ yếu trong khoảng 55–75°F, phản ánh giai đoạn chuyển mùa ôn hòa. Trong khi đó, Mùa Đông có nhiệt độ thấp nhất, phần lớn dưới 50°F, cho thấy điều kiện lạnh rõ rệt. Tổng thể, mật độ điểm cao nhất xuất hiện ở mùa Hè, minh họa sự tập trung lớn của các quan sát trong điều kiện nhiệt độ cao.
1.4.4.2 Mối quan hệ giữa nhiệt độ và mức độ nghiêm trọng
ggplot(Acc, aes(x = `Temperature(F)`)) +
geom_density(aes(fill = factor(Severity)), alpha = 0.7) +
scale_fill_manual(values = c("1" = "#B0B0B0", "2" = "#56B4E9", "3" = "#FF9900", "4" = "#CC3300"),name = "Mức độ",labels = c("1 (Nhẹ nhất)", "2 (Trung bình)", "3 (Nghiêm trọng)", "4 (Cao nhất)")) +
labs(title = "MẬT ĐỘ TAI NẠN THEO NHIỆT ĐỘ VÀ MỨC ĐỘ NGHIÊM TRỌNG",x = "Nhiệt độ (F)",y = "Mật độ") +
theme_minimal() +
theme(plot.title = element_text(face = "bold", hjust = 0.5, size = 10),axis.title.x = element_text(face = "bold", margin = margin(t = 10)),axis.title.y = element_text(face = "bold", margin = margin(r = 10)),legend.position = "bottom")
Câu lệnh: (1–2) vẽ biểu đồ mật độ (density) giữa Temperature(F) và Severity; (3) tô màu thủ công cho 4 mức độ nghiêm trọng (từ xám → đỏ); (4) đặt tiêu đề, nhãn trục; (5–6) theme tối giản, tiêu đề in đậm căn giữa, chú thích ở dưới.
Nhận xét:
Severity 1 có đỉnh rõ quanh 70°F, đường cong hẹp → nhiều va chạm nhẹ xảy ra trong điều kiện ôn hòa, dễ lái. Severity 4 trải rộng và bè hơn, có dấu hiệu hai cực (bimodal) quanh 45–60°F và 70–80°F, gợi ý tai nạn nặng xuất hiện cả khi mát ẩm (mưa, sương) lẫn nóng (mệt mỏi, giảm tập trung).
Quan hệ giữa nhiệt độ và mức độ nghiêm trọng có thể mang dạng chữ U nông: rủi ro cao hơn ở hai biên nhiệt, thấp nhất khi thời tiết ôn hòa.
1.4.4.3 Tương quan giữa nhiệt độ và áp suất
ggplot(Acc, aes(x = `Temperature(F)`, y = `Pressure(in)`)) +
geom_hex(bins = 50) +
scale_fill_viridis_c(option = "cividis",name = "Số vụ\n(Count)",labels = scales::label_number(big.mark = ".")) +
coord_cartesian( xlim = c(quantile(Acc$`Temperature(F)`, 0.01, na.rm=T), quantile(Acc$`Temperature(F)`, 0.99, na.rm=T)),ylim = c(quantile(Acc$`Pressure(in)`, 0.05, na.rm=T), quantile(Acc$`Pressure(in)`, 0.99, na.rm=T))) +
labs(title = "PHÂN BỐ MẬT ĐỘ GIỮA NHIỆT ĐỘ VÀ ÁP SUẤT",subtitle = "Sử dụng Biểu đồ Lục giác (Hexbin Plot)",x = "Nhiệt độ (F)",y = "Áp suất (in)") +
theme_minimal(base_family = "Times New Roman", base_size = 14) +
theme(plot.title = element_text(face = "bold", hjust = 0.5, size = 14),plot.subtitle = element_text(hjust = 0.5, size = 14, color = "gray50"),panel.grid.minor = element_blank())
Câu lệnh: (1–2) vẽ hexbin thể hiện mật độ giữa Temperature(F) và Pressure(in); (3–4) tô màu theo số vụ bằng thang cividis, định dạng số có dấu chấm; (5) giới hạn trục ở khoảng 1–99% để loại ngoại lệ; (6) đặt tiêu đề, phụ đề, nhãn trục; (7–8) dùng theme Times New Roman, tiêu đề in đậm căn giữa, ẩn lưới phụ.
Nhận xét: Biểu đồ lục giác (hexbin) cho thấy mật độ tai nạn cao nhất tập trung quanh nhiệt độ trung bình – ấm (60–80°F) và áp suất gần chuẩn (29,5–30,3 inHg). Điều này phản ánh đa số tai nạn xảy ra trong điều kiện thời tiết ôn hòa, phổ biến, chứ không phải cực đoan – minh chứng cho hiệu ứng phơi nhiễm: điều kiện càng thường gặp thì tổng số vụ càng nhiều. Khối màu nghiêng nhẹ theo hướng “nhiệt độ tăng → áp suất giảm”, phù hợp với quy luật khí tượng, nhưng độ nghiêng nhỏ → tương quan yếu, chịu ảnh hưởng bởi nhiều yếu tố khác như độ cao, mùa vụ, độ ẩm, mưa hay cấu trúc đô thị.
2 Chương 2: Phân tích cơ cấu và xu hướng biến động tài sản SHB giai đoạn 2014–2023
2.1 Tổng quan về dữ liệu
Bộ dữ liệu được sử dụng trong đề tài là báo cáo tài chính hợp nhất của Ngân hàng TMCP Sài Gòn – Hà Nội (SHB) trong giai đoạn từ năm 2014 đến năm 2023. Dữ liệu được thu thập từ báo cáo thường niên và báo cáo tài chính đã kiểm toán công bố trên trang thông tin điện tử chính thức của SHB. Dữ liệu bao gồm các chỉ tiêu tài chính cơ bản phản ánh cơ cấu tài sản của ngân hàng, được tổng hợp theo từng năm, giúp đánh giá sự biến động tài sản, danh mục đầu tư và hoạt động tín dụng của SHB trong giai đoạn 10 năm nghiên cứu.
2.1.1 Nhập và cấu trúc dữ liệu
2.1.1.1 Nhập dữ liệu
Hàm read_csv() được dùng để đọc tệp dữ liệu định dạng CSV (Comma-Separated Values)
2.1.1.2 Xem kích thước bộ dữ liệu
## [1] 10 12Câu lệnh: dim() là hàm trong R dùng để trả về kích thước của một đối tượng dạng bảng
Kết quả: Bộ dữ liệu shb có 10 dòng và 12 cột (biến số): 10 năm tài chính từ 2014 đến 2023, tương ứng với 10 quan sát; 12 biến (chỉ tiêu tài chính) phản ánh cơ cấu tài sản của Ngân hàng SHB.
2.1.1.3 Kiểm tra kiểu dữ liệu
## Year Tổng Tài Sản Chứng Khoán Đầu Tư Góp Vốn Dài Hạn Tiền Gửi Khách Hàng Cho vay các TCTD khác
## "numeric" "numeric" "numeric" "numeric" "numeric" "numeric"
## Chứng khoán Kinh Doanh Tiền Vàng Ngoại Tệ Tiền Gửi NHNN TS Hữu Hình TS Vô Hình Tài Sản Khác
## "numeric" "numeric" "numeric" "numeric" "numeric" "numeric"Câu lệnh sapply(shb, class) trong R được sử dụng để kiểm tra kiểu dữ liệu (class) của từng biến trong bộ dữ liệu shb.
Tất cả 12 biến của bộ dữ liệu SHB đều là numeric, nên có thể đưa vào tính toán, thống kê và mô hình hóa trong R ngay lập tức mà không cần chuyển đổi.
2.1.1.4 Kiểm tra kiểu đối tượng của bảng
Sử dụng hàm class() là để xác định kiểu đối tượng của dữ liệu đang được lưu trong biến shb.
## [1] "spec_tbl_df" "tbl_df" "tbl" "data.frame"spec_tbl_df: là lớp đặc biệt được tạo ra khi dữ liệu được đọc bằng read_csv() từ gói readr; tbl_df và tbl: là lớp dữ liệu của tibble, một phiên bản “nâng cấp” của data.frame trong tidyverse — giúp hiển thị đẹp, gọn, và không tự động chuyển kiểu dữ liệu; data.frame: lớp dữ liệu cơ bản trong R, đảm bảo tương thích ngược với các hàm base R.
2.1.1.5 Liệt kê tên các biến
## [1] "Year" "Tổng Tài Sản" "Chứng Khoán Đầu Tư" "Góp Vốn Dài Hạn" "Tiền Gửi Khách Hàng" "Cho vay các TCTD khác"
## [7] "Chứng khoán Kinh Doanh" "Tiền Vàng Ngoại Tệ" "Tiền Gửi NHNN" "TS Hữu Hình" "TS Vô Hình" "Tài Sản Khác"Câu lệnh names() là hàm trong R dùng để xem hoặc thay đổi tên các biến (tên cột) của một data frame.
“Year”: Năm tài chính ghi nhận giai đoạn báo cáo (2014–2023), dùng để xác định thời gian và phân tích xu hướng biến động tài sản qua các năm. Đơn vị: năm.
“Tổng Tài Sản”: Tổng giá trị tài sản SHB sở hữu tại cuối năm, thể hiện quy mô hoạt động và năng lực tài chính. Đơn vị: VND.
“Chứng Khoán Đầu Tư”: Giá trị đầu tư vào cổ phiếu, trái phiếu và công cụ tài chính khác, phản ánh chiến lược đầu tư và quản lý danh mục của SHB. Đơn vị: VND.
“Góp Vốn Dài Hạn”: Giá trị đầu tư dài hạn vào công ty con, liên kết hoặc dự án, thể hiện chiến lược mở rộng đầu tư dài hạn. Đơn vị: VND.
“Tiền Gửi Khách Hàng”: Tổng giá trị tiền gửi của cá nhân và tổ chức tại SHB – nguồn vốn huy động chủ yếu phục vụ cho vay và đầu tư. Đơn vị: VND.
“Cho vay các TCTD khác”: Giá trị cho vay giữa SHB và các tổ chức tín dụng khác, phản ánh khả năng hỗ trợ thanh khoản và hợp tác liên ngân hàng. Đơn vị: VND.
“Chứng Khoán Kinh Doanh”: Giá trị chứng khoán nắm giữ để mua bán ngắn hạn, thể hiện tính linh hoạt và khả năng tận dụng cơ hội thị trường. Đơn vị: VND.
“Tiền Vàng Ngoại Tệ”: Giá trị tiền mặt, vàng và ngoại tệ quy đổi, thể hiện khả năng thanh khoản và dự trữ tiền tệ của ngân hàng. Đơn vị: VND.
“Tiền Gửi NHNN”: Số tiền gửi tại Ngân hàng Nhà nước, gồm dự trữ bắt buộc và thanh toán, phản ánh mức độ tuân thủ và khả năng thanh khoản hệ thống. Đơn vị: VND.
“TS Hữu Hình”: Giá trị tài sản vật chất (trụ sở, thiết bị, máy móc), thể hiện cơ sở hạ tầng và năng lực hoạt động. Đơn vị: VND.
“TS Vô Hình”: Giá trị tài sản phi vật chất (phần mềm, thương hiệu, bản quyền), phản ánh năng lực công nghệ và giá trị thương hiệu. Đơn vị: VND.
“Tài Sản Khác”: Các tài sản còn lại như phải thu, tài sản chờ xử lý, thể hiện phần tài sản phụ trợ và tiềm ẩn rủi ro. Đơn vị: VND.
2.1.2 Khám phá và mô tả sơ bộ
2.1.2.1 Hiển thị 5 dòng đầu tiên của dữ liệu
shb_view <- shb
shb_view[-which(names(shb_view)=="Year")] <- lapply(shb_view[-which(names(shb_view)=="Year")],
function(x) formatC(x, format = "f", digits = 0, big.mark = ".", decimal.mark = ","))
head(shb_view, n = 5, width = Inf)## # A tibble: 5 × 12
## Year `Tổng Tài Sản` `Chứng Khoán Đầu Tư` `Góp Vốn Dài Hạn` `Tiền Gửi Khách Hàng` `Cho vay các TCTD khác` `Chứng khoán Kinh Doanh` `Tiền Vàng Ngoại Tệ`
## <dbl> <chr> <chr> <chr> <chr> <chr> <chr> <chr>
## 1 2023 630.500.685.000.000 32.063.660.000.000 414.448.000.000 447.503.426.000.000 4.999.952.000.000 7.792.742.000.000 1.370.849.000.000
## 2 2022 550.904.120.000.000 32.954.676.000.000 46.699.000.000 361.675.593.000.000 3.863.000.000.000 1.547.000.000 1.897.545.000.000
## 3 2021 506.604.328.000.000 25.104.577.000.000 131.652.000.000 327.196.828.000.000 6.911.000.000.000 3.245.000.000 1.878.293.000.000
## 4 2020 412.679.593.000.000 28.639.598.000.000 133.140.000.000 303.581.729.000.000 5.654.006.000.000 960.000.000 1.619.927.000.000
## 5 2019 365.254.318.000.000 21.604.317.000.000 133.140.000.000 259.236.746.000.000 NA 502.000.000 1.754.801.000.000
## # ℹ 4 more variables: `Tiền Gửi NHNN` <chr>, `TS Hữu Hình` <chr>, `TS Vô Hình` <chr>, `Tài Sản Khác` <chr>Câu lệnh: (2) tìm vị trí cột Year, lấy chỉ số của cột đó. (4) hiển thị 5 số dòng đầu tiên của bộ dữ liệu.
Kết quả cho thấy dữ liệu shb gồm 12 cột (biến) và các giá trị thuộc 5 năm gần nhất (2019–2023).
2.1.2.2 Hiển thị 5 dòng cuối của dữ liệu
shb_view1 <- shb
shb_view1[-which(names(shb_view)=="Year")] <- lapply(shb_view[-which(names(shb_view)=="Year")],
function(x) formatC(x, format = "f", digits = 0, big.mark = ".", decimal.mark = ","))
tail(shb_view1,n= 5,width = Inf )## # A tibble: 5 × 12
## Year `Tổng Tài Sản` `Chứng Khoán Đầu Tư` `Góp Vốn Dài Hạn` `Tiền Gửi Khách Hàng` `Cho vay các TCTD khác` `Chứng khoán Kinh Doanh` `Tiền Vàng Ngoại Tệ`
## <dbl> <chr> <chr> <chr> <chr> <chr> <chr> <chr>
## 1 2018 323.276.008.000.000 48.026.925.000.000 195.767.000.000 225.224.141.000.000 " 91.252.000.000" " 655.000.000" "1.884.822.000.000"
## 2 2017 286.010.081.000.000 21.207.964.000.000 215.465.000.000 194.889.770.000.000 " 96.575.000.000" " 1.050.000.000" "1.446.548.000.000"
## 3 2016 233.947.740.000.000 18.846.623.000.000 222.949.000.000 166.576.217.000.000 " 8.592.759.000.000" " 40.899.000.000" "1.291.694.000.000"
## 4 2015 204.704.140.000.000 17.316.651.000.000 303.409.000.000 148.828.876.000.000 "10.651.971.000.000" " 54.378.000.000" "1.917.860.000.000"
## 5 2014 169.035.546.000.000 13.471.098.000.000 321.032.000.000 123.227.619.000.000 " 8.841.433.000.000" " 31.828.000.000" " 801.433.000.000"
## # ℹ 4 more variables: `Tiền Gửi NHNN` <chr>, `TS Hữu Hình` <chr>, `TS Vô Hình` <chr>, `Tài Sản Khác` <chr>Câu lệnh: (2) tìm vị trí cột Year, lấy chỉ số của cột đó .(4) hiển thị 5 số dòng cuối cùng của bộ dữ liệu.
Kết quả cho thấy dữ liệu shb gồm 12 cột (biến) và các giá trị thuộc 5 năm(2019 - 2023)
2.1.2.3 Kiểm tra giá trị trùng lặp
Kiểm tra trùng lặp là bước bắt buộc để bảo đảm toàn vẹn dữ liệu: các dòng lặp có thể bóp méo thống kê (trung bình, phương sai) và làm sai mô hình. Xác nhận rằng mỗi năm là duy nhất giúp kết quả phân tích đáng tin cậy.
## [1] 0Câu lệnh: Hàm sum() cộng tất cả các giá trị TRUE, tức là đếm số dòng bị trùng lặp trong toàn bộ bảng dữ liệu.
Kết quả: [1] 0 cho thấy không có dòng nào trùng lặp trong bộ dữ liệu.
2.1.2.4 Kiểm tra phạm vi năm
Xác định khoảng thời gian quan sát mà dữ liệu bao phủ — từ năm nào đến năm nào.
## [1] 2014 2023*Câu lệnh: range()** trong R được dùng để trả về giá trị nhỏ nhất và lớn nhất của một vector số. → Câu lệnh này sẽ cho biết năm đầu tiên và năm cuối cùng có trong dữ liệu SHB.
Kết quả: [1] 2014 2023, cho thấy bộ dữ liệu SHB bao gồm 10 năm liên tiếp từ 2014 đến 2023. → Điều này chứng tỏ dữ liệu có tính liên tục theo thời gian, rất phù hợp cho các phân tích xu hướng, dự báo.
2.1.3 Kiểm tra chất lượng dữ liệu
2.1.3.1 Kiểm tra NA cho mỗi cột
## Year Tổng Tài Sản Chứng Khoán Đầu Tư Góp Vốn Dài Hạn Tiền Gửi Khách Hàng Cho vay các TCTD khác
## 0 0 0 0 0 1
## Chứng khoán Kinh Doanh Tiền Vàng Ngoại Tệ Tiền Gửi NHNN TS Hữu Hình TS Vô Hình Tài Sản Khác
## 0 0 0 0 0 0Câu lệnh: colSums(is.na(shb)) trong R được sử dụng để kiểm tra giá trị bị thiếu (NA) trong từng cột của bộ dữ liệu shb.
Nhận xét: Kết quả cho thấy hầu hết các biến trong bộ dữ liệu đều có giá trị 0, nghĩa là không có giá trị bị thiếu, ngoại trừ biến “Cho vay các TCTD khác” có 1 giá trị NA.
Nguyên nhân NA ở “Cho vay các TCTD khác” có thể do không phát sinh năm đó hoặc thay đổi cách trình bày kế toán (gộp chỉ tiêu). => Cần xác minh nguyên nhân NA và xử lý nhất quán.
2.1.3.2 Kiểm tra giá trị âm bất thường
Các chỉ tiêu như Tổng tài sản, Tiền gửi, CK đầu tư, Góp vốn dài hạn… phải dương; giá trị âm thường là lỗi nhập hoặc định dạng. Vì vậy, kiểm tra dấu giúp xác thực dữ liệu trước khi phân tích sâu.
shb %>% summarise(across(-Year, ~ sum(.x < 0))) %>% pivot_longer(everything(),
names_to = "Chỉ tiêu", values_to = "Số lượng giá trị âm")## # A tibble: 11 × 2
## `Chỉ tiêu` `Số lượng giá trị âm`
## <chr> <int>
## 1 Tổng Tài Sản 0
## 2 Chứng Khoán Đầu Tư 0
## 3 Góp Vốn Dài Hạn 0
## 4 Tiền Gửi Khách Hàng 0
## 5 Cho vay các TCTD khác NA
## 6 Chứng khoán Kinh Doanh 0
## 7 Tiền Vàng Ngoại Tệ 0
## 8 Tiền Gửi NHNN 0
## 9 TS Hữu Hình 0
## 10 TS Vô Hình 0
## 11 Tài Sản Khác 0Câu lệnh: (1) đếm số lượng giá trị nhỏ hơn 0 trong từng cột.(Trừ cột Year); (2) Đổi tên cột
Nhận xét: Tất cả các biến trong kết quả đều có giá trị 0, nghĩa là không có giá trị âm nào trong dữ liệu. Riêng cột “Cho vay các TCTD khác” hiển thị NA, điều này cho thấy trong cột này có ít nhất một giá trị bị thiếu (NA) nên không thể tính tổng điều kiện được.=> cần được xử lý hoặc thay thế phù hợp trước khi tiến hành các phân tích thống kê.
2.2 Xử lý dữ liệu thô và mã hoá dữ liệu
2.2.1 Chuẩn bị và tiền xử lý dữ liệu
2.2.1.1 Sao lưu dữ liệu gốc
Toán tử <- gán toàn bộ nội dung của shb sang biến mới shb1.
Việc này cho phép nhà phân tích thực hiện các thao tác xử lý, biến đổi hoặc kiểm định dữ liệu trên biến mới shb1 mà không ảnh hưởng đến cấu trúc và nội dung của dữ liệu ban đầu. Đây là một thực hành phổ biến trong phân tích dữ liệu, nhằm đảm bảo tính an toàn, khả năng tái lập và so sánh giữa dữ liệu gốc và dữ liệu đã qua xử lý.
2.2.1.2 Sắp xếp theo thời gian tăng dần
Sắp xếp dữ liệu theo thứ tự thời gian giúp quan sát xu hướng chính xác, thực hiện các phép tính chuỗi thời gian và đảm bảo biểu đồ hiển thị đúng diễn tiến.
arrange(Year): hàm giúp sắp xếp các dòng dữ liệu theo giá trị của biến, mặc định là sắp xếp tăng dần (từ năm nhỏ đến năm lớn).
2.2.1.3 Chuẩn hoá tên biến
Chuẩn hóa tên biến giúp dễ đọc, nhất quán và tránh lỗi cú pháp khi xử lý dữ liệu.
simple_names <- function(x){x <- stringi::stri_trans_general(x, "Latin-ASCII")
x <- tolower(x)
x <- gsub("[^a-z0-9]+","_", x)
gsub("(^_|_$)", "", x)}
shb1 <- shb
names(shb1) <- simple_names(names(shb1))
names(shb1)## [1] "year" "tong_tai_san" "chung_khoan_dau_tu" "gop_von_dai_han" "tien_gui_khach_hang" "cho_vay_cac_tctd_khac"
## [7] "chung_khoan_kinh_doanh" "tien_vang_ngoai_te" "tien_gui_nhnn" "ts_huu_hinh" "ts_vo_hinh" "tai_san_khac"Câu lệnh: (1) bỏ dấu tiếng Việt.(2) chuyển toàn bộ chữ hoa → chữ thường.(3) thay mọi ký tự không phải chữ hoặc số bằng dấu gạch dưới _.(4) xóa dấu gạch dưới ở đầu hoặc cuối tên biến nếu có. (5) Dòng này thay toàn bộ tên biến cũ bằng phiên bản đã chuẩn hóa.
=> Kết quả cuối cùng là một bộ dữ liệu có tên biến ngắn gọn, thống nhất và đúng chuẩn lập trình R.
2.2.1.4 Xử lý NA
Kết quả kiểm tra NA ở trên cho thấy “Cho vay các TCTD khác” hiển thị NA. Thiếu dữ liệu theo năm (NA) sẽ làm hỏng tính toán và mô hình. Với chuỗi thời gian tài chính vốn biến động trơn, khi chỉ thiếu 1 năm, có thể nội suy cục bộ: lấy trung bình 3 năm lân cận (t−2, t−1, t+1) để ước lượng.
- Tìm vị trí NA:
## [1] 5Câu lệnh: is.na tạo vecto True/False cho biết phần tử nào đang có giá trị NA; which(..) trả về chỉ số hàng có giá trị NA
Kết quả: [1] 5 cho biết giá trị bị thiếu nằm ở hàng thứ 5 trong cột này.
- Thay thế NA bằng bình quân các năm lân cận:
shb1 <- shb1 %>% mutate(cho_vay_cac_tctd_khac =
ifelse(is.na(cho_vay_cac_tctd_khac),(
lag(cho_vay_cac_tctd_khac, 2) +
lag(cho_vay_cac_tctd_khac, 1) +
lead(cho_vay_cac_tctd_khac, 1)) / 3, cho_vay_cac_tctd_khac))Câu lệnh: (1) tạo mới hoặc thay đổi giá trị biến trong dataframe. (2) kiểm tra ô nào bị thiếu. Nếu bị thiếu → thay bằng trung bình của 3 giá trị lân cận
- Kiểm tra còn giá trị NA không
## year tong_tai_san chung_khoan_dau_tu gop_von_dai_han tien_gui_khach_hang cho_vay_cac_tctd_khac
## 0 0 0 0 0 0
## chung_khoan_kinh_doanh tien_vang_ngoai_te tien_gui_nhnn ts_huu_hinh ts_vo_hinh tai_san_khac
## 0 0 0 0 0 0=> Kết quả cho thấy số lượng NA ở các biến là 0, có nghĩa là hiện tại trong cột cho_vay_cac_tctd_khac không còn bất kỳ giá trị NA nào nữa.
2.2.2 Tạo biến và mã hóa thông tin
2.2.2.1 Tạo các tỷ trọng
Chuẩn hóa tất cả khoản mục về tỷ trọng % giúp so sánh đóng góp từng loại tài sản vào tổng tài sản qua các năm, phân tích cơ cấu tài sản (đang tập trung vào gì) và theo dõi xu hướng tăng/giảm rõ ràng hơn so với số tuyệt đối.
shb1 <- shb1 %>% mutate(
pct_tvnt = tien_vang_ngoai_te / tong_tai_san * 100,
pct_Tien_gui_NHNN = tien_gui_nhnn / tong_tai_san * 100,
pct_ChoVay_TCTD_khac = cho_vay_cac_tctd_khac / tong_tai_san * 100,
pct_CK_kinh_doanh = chung_khoan_kinh_doanh / tong_tai_san * 100,
pct_CK_dau_tu = chung_khoan_dau_tu / tong_tai_san * 100,
pct_TS_huu_hinh = ts_huu_hinh / tong_tai_san * 100,
pct_TS_vo_hinh = ts_vo_hinh / tong_tai_san * 100,
pct_TS_khac = tai_san_khac / tong_tai_san * 100,
pct_GopVon = gop_von_dai_han / tong_tai_san * 100)Câu lệnh: (2) → Tạo cột mới tên pct_tvnt, thể hiện tỷ trọng Tiền vàng ngoại tệ trong Tổng tài sản (theo %). (3) -> (9) các dòng sau tương tự:
pct_Tien_gui_NHNN: Tỷ trọng Tiền gửi tại Ngân hàng Nhà nước
pct_ChoVay_TCTD_khac: Tỷ trọng Cho vay các TCTD khác
pct_CK_kinh_doanh: Tỷ trọng Chứng khoán kinh doanh
pct_CK_dau_tu: Tỷ trọng Chứng khoán đầu tư
pct_TS_huu_hinh: Tỷ trọng Tài sản hữu hình
pct_TS_vo_hinh: Tỷ trọng Tài sản vô hình
pct_TS_khac: Tỷ trọng Tài sản khác
pct_GopVon: Tỷ trọng vốn góp dài hạn
2.2.2.2 Tính tăng trưởng hàng năm
Tỷ lệ % giúp so sánh giữa các năm bất kể quy mô, nhận diện xu hướng (ổn định/đột biến/suy giảm), và là cơ sở đánh giá hiệu quả mở rộng tài sản, danh mục đầu tư. Nói cách khác, đây là bước phân tích động, chuyển từ mô tả tĩnh sang theo dõi biến động theo thời gian.
shb1 <- shb1 %>% arrange(year) %>% mutate(
g_Tong_TS = (tong_tai_san / lag(tong_tai_san) - 1) * 100,
g_GopVon = (gop_von_dai_han / lag(gop_von_dai_han) - 1) * 100,
g_CK = (chung_khoan_dau_tu / lag(chung_khoan_dau_tu) - 1) * 100)Câu lệnh: (1) Tạo thêm các biến mới trong bảng dữ liệu để lưu trữ kết quả tăng trưởng; (2) -> (4) Lấy giá trị của biến x ở năm liền trước, tính tốc độ tăng trưởng (%) giữa hai năm liên tiếp
=> Bảng shb1 sẽ có thêm 3 cột thể hiện tốc độ tăng trưởng năm sau so với năm trước.
2.2.2.3 Tính CAGR 2014-2023 cho tổng tài sản
Khi phân tích chuỗi thời gian tài chính, CAGR (Compound Annual Growth Rate) cho biết tốc độ tăng trưởng kép bình quân năm, phản ánh xu hướng dài hạn ổn định hơn so với biến động từng năm.
cagr <- function(x) {x <- na.omit(x)
if(length(x) < 2) return(NA)
n <- length(x)
first <- x[1]; last <- x[n]
((last/first)^(1/(n-1)) - 1) * 100}
cagr_TongTS <- cagr(shb1$tong_tai_san)Câu lệnh (1) Loại bỏ các giá trị bị thiếu để đảm bảo phép tính chính xác. (2) Nếu dữ liệu có ít hơn 2 điểm, thì không thể tính CAGR ⇒ trả về giá trị NA. (3) Đếm số lượng năm trong chuỗi dữ liệu. (4) Lấy giá trị đầu tiên và giá trị cuối cùng. (5) Đây là công thức tính CAGR.
2.2.3 Phân tích và phân tổ dữ liệu
2.2.3.1 Phân tổ theo giai đoạn
Chia chuỗi thời gian thành hai giai đoạn 2014–2018 (quy mô còn nhỏ, tăng trưởng ban đầu) và 2019–2023 (mở rộng nhanh) giúp so sánh quy mô bình quân (ví dụ: tổng tài sản bình quân), tốc độ tăng trưởng bình quân từng giai đoạn và làm rõ thay đổi chiến lược theo thời kỳ.
shb1 <- shb1 %>%
mutate(giai_doan = ifelse(year <= 2018, "2014-2018", "2019-2023"))
grp_gd <- shb1 %>%
group_by(giai_doan) %>%
summarise(so_nam = n(),
tong_ts_bq = mean(tong_tai_san, na.rm = TRUE),
g_tong_ts_bq = mean(g_Tong_TS, na.rm = TRUE))Câu lệnh: (2) Tạo biến mới “giai_doan” để chia dữ liệu thành hai nhóm. (4) Gom nhóm dữ liệu theo từng giai đoạn để tính toán riêng cho từng nhóm. (5) Tính toán các chỉ tiêu thống kê tổng hợp cho mỗi giai đoạn.
2.2.3.2 Phân tổ theo quy mô tổng tài sản (tứ phân vị)
Phân tổ theo tứ phân vị chia các năm thành 4 nhóm theo quy mô Tổng tài sản (nhỏ–trung bình–lớn–rất lớn) để so sánh đặc điểm giữa các mức quy mô, phân tích mối quan hệ giữa quy mô và cơ cấu tài sản (như tỷ trọng góp vốn dài hạn khi tài sản tăng), và nhận diện xu hướng phát triển.
cuts <- quantile(shb1$tong_tai_san, probs = c(0, .25, .5, .75, 1),
na.rm = TRUE)
shb1 <- shb1 %>%
mutate(quy_mo_ts = cut(tong_tai_san, breaks = unique(cuts),
include.lowest = TRUE))
grp_quymo <- shb1 %>%
group_by(quy_mo_ts) %>%
summarise(
so_nam = n(),
tong_ts_tb = mean(tong_tai_san, na.rm = TRUE),
ty_trong_gop_von_tb = mean(pct_GopVon, na.rm = TRUE))Câu lệnh: (1) chia dải dữ liệu thành các mốc phần trăm theo thứ tự tăng dần. (4) tạo biến mới quy_mo_ts để phân loại mỗi năm vào nhóm quy mô tương ứng. (7) Gom nhóm dữ liệu theo từng mức quy mô tài sản. (8) → Tính các chỉ tiêu thống kê cho từng nhóm
2.2.3.3 Phân tổ theo tốc độ tăng Tổng tài sản (YoY)
Phân loại các năm theo tốc độ tăng trưởng Tổng tài sản (YoY) giúp đo mức biến động hằng năm, so sánh cơ cấu tài sản giữa các nhóm năm có mức tăng khác nhau và nhận diện xu hướng phân bổ.
shb1 <- shb1 %>% mutate(nhom_tang_truong = case_when(
is.na(g_Tong_TS) ~ NA_character_,
g_Tong_TS < 0 ~ "Giảm",
g_Tong_TS <= 10 ~ "Tăng nhẹ (0-10%)",
TRUE ~ "Tăng mạnh (>10%)"))
grp_yoy <- shb1 %>%
group_by(nhom_tang_truong) %>%
summarise(
so_nam = n(),
tong_ts_tb = mean(tong_tai_san, na.rm = TRUE),
ck_dau_tu_tb = mean(chung_khoan_dau_tu, na.rm = TRUE))Câu lệnh: (1) Tạo biến mới nhom_tang_truong để phân loại từng năm theo mức tăng trưởng Tổng tài sản (g_Tong_TS); (7) Gom nhóm dữ liệu theo từng loại tốc độ tăng trưởng (3 nhóm). (8) Tính các chỉ tiêu trung bình cho từng nhóm tăng trưởng
2.3 Thống kê cơ bản về dữ liệu
2.3.1 Thống kê mô tả cơ bản
2.3.1.1 Thống kê mô tả tiền gửi khách hàng
stat_table <- function(data, var, digits_num = 2) {
desc_main <- data %>% dplyr::summarise(
n = sum(!is.na({{var}})),
min = min({{var}}, na.rm = TRUE),
q1 = stats::quantile({{var}}, 0.25, na.rm = TRUE),
med = stats::median({{var}}, na.rm = TRUE),
q3 = stats::quantile({{var}}, 0.75, na.rm = TRUE),
max = max({{var}}, na.rm = TRUE),
mean = mean({{var}}, na.rm = TRUE),
sd = stats::sd({{var}}, na.rm = TRUE))
vn_labels <- c(n="Số quan sát", min="Nhỏ nhất", q1="Q1 (25%)", med="Trung vị",q3="Q3 (75%)", max="Lớn nhất", mean="Trung bình", sd="Độ lệch chuẩn")
desc_long <- desc_main %>%
tidyr::pivot_longer(dplyr::everything(),names_to="key", values_to="value_num") %>%
dplyr::mutate(`Chỉ tiêu` = vn_labels[key],.order = match(key, names(vn_labels))) %>%
dplyr::arrange(.order) %>%
dplyr::select(dplyr::all_of(c("Chỉ tiêu","value_num")))
desc_view <- desc_long %>%
dplyr::mutate(value_num = as.numeric(value_num),`Giá trị` = dplyr::if_else(`Chỉ tiêu` == "Số quan sát",formatC(value_num, format="f", digits=0, big.mark=".", decimal.mark=","),formatC(value_num, format="f", digits=digits_num, big.mark=".", decimal.mark=","))) %>%
dplyr::select(dplyr::all_of(c("Chỉ tiêu","Giá trị")))
list(numeric = desc_long, view = desc_view)}
tab_tgkh <- stat_table(shb1, tien_gui_khach_hang, digits_num = 2)
cat("\nThống kê mô tả - Tiền gửi khách hàng:\n")##
## Thống kê mô tả - Tiền gửi khách hàng:## # A tibble: 8 × 2
## `Chỉ tiêu` `Giá trị`
## <chr> <chr>
## 1 Số quan sát 10
## 2 Nhỏ nhất 123.227.619.000.000,00
## 3 Q1 (25%) 173.654.605.250.000,00
## 4 Trung vị 242.230.443.500.000,00
## 5 Q3 (75%) 321.293.053.250.000,00
## 6 Lớn nhất 447.503.426.000.000,00
## 7 Trung bình 255.794.094.500.000,00
## 8 Độ lệch chuẩn 103.803.412.800.432,94Câu lệnh: (1) Định nghĩa hàm stat_table() để tính thống kê mô tả; (2–10) Tính các giá trị; (11) Tạo nhãn tiếng Việt cho các chỉ tiêu; (12–14) Chuyển dữ liệu sang dạng dài gồm tên chỉ tiêu và giá trị; (15–16) Gán nhãn tiếng Việt, sắp xếp đúng thứ tự, chỉ giữ hai cột “Chỉ tiêu” và “value_num”; (21) In bảng kết quả thống kê mô tả gọn gàng không hiển thị số dòng.
Nhận xét: Tiền gửi khách hàng của SHB tăng mạnh qua các năm, với giá trị nhỏ nhất khoảng 123,23 nghìn tỷ và lớn nhất 447,50 nghìn tỷ, phản ánh xu hướng mở rộng quy mô huy động vốn rõ rệt. Phân bố hơi lệch phải khi trung bình (255,79) cao hơn trung vị (242,23), cho thấy một số năm huy động vượt trội kéo trung bình tăng. Độ lệch chuẩn 103,80 nghìn tỷ (≈40% trung bình) thể hiện mức biến động lớn, cho thấy tăng trưởng tiền gửi chưa ổn định.
2.3.1.2 Thống kê mô tả tổng tài sản
desc_main <- shb1 %>%dplyr::summarise(n = dplyr::n(),
tong_ts_min = min(tong_tai_san, na.rm = TRUE),
tong_ts_q1 = stats::quantile(tong_tai_san, 0.25, na.rm = TRUE),
tong_ts_med = stats::median(tong_tai_san, na.rm = TRUE),
tong_ts_q3 = stats::quantile(tong_tai_san, 0.75, na.rm = TRUE),
tong_ts_max = max(tong_tai_san, na.rm = TRUE),
tong_ts_mean= mean(tong_tai_san, na.rm = TRUE),
tong_ts_sd = stats::sd(tong_tai_san, na.rm = TRUE))
vn_labels <- c(n="Số quan sát", tong_ts_min="Nhỏ nhất", tong_ts_q1="Q1 (25%)",
tong_ts_med="Trung vị", tong_ts_q3="Q3 (75%)", tong_ts_max="Lớn nhất",
tong_ts_mean="Trung bình", tong_ts_sd="Độ lệch chuẩn")
order_keys <- names(vn_labels)
desc_long <- desc_main %>%
tidyr::pivot_longer(dplyr::everything(), names_to = "key", values_to = "value_num") %>%
dplyr::mutate(`Chỉ tiêu` = vn_labels[key],.order = match(key, order_keys)) %>%
dplyr::arrange(.order) %>%
dplyr::select(dplyr::all_of(c("Chỉ tiêu","value_num")))
digits_num <- 2
desc_view_col <- desc_long %>%dplyr::mutate(value_num = as.numeric(value_num),`Giá trị` = dplyr::if_else(`Chỉ tiêu` == "Số quan sát",formatC(value_num, format = "f", digits = 0, big.mark = ".", decimal.mark = ","),formatC(value_num, format = "f", digits = digits_num, big.mark = ".", decimal.mark = ","))) %>%
dplyr::select(dplyr::all_of(c("Chỉ tiêu","Giá trị")))
cat("\nThống kê mô tả - Tổng tài sản:\n")##
## Thống kê mô tả - Tổng tài sản:## # A tibble: 8 × 2
## `Chỉ tiêu` `Giá trị`
## <chr> <chr>
## 1 Số quan sát 10
## 2 Nhỏ nhất 169.035.546.000.000,00
## 3 Q1 (25%) 246.963.325.250.000,00
## 4 Trung vị 344.265.163.000.000,00
## 5 Q3 (75%) 483.123.144.250.000,00
## 6 Lớn nhất 630.500.685.000.000,00
## 7 Trung bình 368.291.655.900.000,00
## 8 Độ lệch chuẩn 155.105.563.760.525,47Câu lệnh: (1–8) Tóm tắt “Tổng tài sản”; (9–11) Tạo nhãn tiếng Việt cho từng chỉ tiêu và thứ tự mong muốn; (13–16) Đổi sang dạng dài, gán nhãn “Chỉ tiêu”, sắp xếp theo thứ tự, giữ 2 cột; (18) Chọn số lẻ hiển thị = 2.
Nhận xét: Tổng tài sản SHB giai đoạn 2014–2023 tăng mạnh và ổn định, từ 169 nghìn tỷ lên hơn 630 nghìn tỷ đồng. Giá trị trung bình 368 nghìn tỷ, trung vị 344 nghìn tỷ, với độ lệch chuẩn ~155 nghìn tỷ, cho thấy quy mô mở rộng nhanh nhưng còn dao động. Nhìn chung, ngân hàng duy trì đà tăng trưởng bền vững, phản ánh quá trình mở rộng quy mô tích cực.
2.3.1.3 IQR & hệ số biến thiên (CV)
IQR (khoảng tứ phân vị): đo độ phân tán của nhóm 50% dữ liệu trung tâm, giúp xem tài sản của SHB dao động mạnh hay yếu.
CV (hệ số biến thiên): đo mức độ dao động tương đối so với giá trị trung bình, cho biết tổng tài sản của ngân hàng biến động bao nhiêu phần trăm quanh mức trung bình qua các năm.
stopifnot(exists("shb1"))
v <- shb1$tong_tai_san
x <- v / 1e9
iqr_ts <- IQR(x, na.rm = TRUE)
cv_ts <- sd(x, na.rm = TRUE) / mean(x, na.rm = TRUE)
iqr_view <- formatC(iqr_ts, format="f", digits=0, big.mark=".", decimal.mark=",")
cv_view <- paste0(formatC(cv_ts*100, format="f", digits=2, big.mark=".",
decimal.mark=","), " %")
cat("IQR (Tổng tài sản, tỷ đồng): ", iqr_view, "\n",
"Hệ số biến thiên (CV): ", cv_view, "\n", sep="")## IQR (Tổng tài sản, tỷ đồng): 236.160
## Hệ số biến thiên (CV): 42,11 %Giải thích code: (2) Lấy cột Tổng tài sản từ bảng shb1.(3) Đổi đơn vị từ đồng sang tỷ đồng. (4) Tính khoảng tứ phân vị (IQR) của tổng tài sản. (5) Tính hệ số biến thiên (CV) = độ lệch chuẩn / trung bình. (6) Định dạng số theo kiểu Việt Nam
Nhận xét: IQR ≈ 236,16 nghìn tỷ cho thấy phần lớn tổng tài sản SHB nằm trong khoảng 247–483 nghìn tỷ, phản ánh mức tăng mạnh và phân tán cao. CV ≈ 42,1% thể hiện dao động lớn quanh trung bình, cho thấy tăng trưởng chưa ổn định. => SHB mở rộng quy mô nhanh nhưng biến động cao, phù hợp với giai đoạn tăng trưởng mạnh mẽ 2014–2023.
2.3.1.4 Kiểm tra NA (đếm & tỷ lệ)
Kiểm tra dữ liệu bị thiếu (NA) trong bộ dữ liệu shb1, bao gồm cả số lượng và tỷ lệ phần trăm giá trị bị thiếu của từng biến.
## year tong_tai_san chung_khoan_dau_tu gop_von_dai_han tien_gui_khach_hang cho_vay_cac_tctd_khac
## 0 0 0 0 0 0
## chung_khoan_kinh_doanh tien_vang_ngoai_te tien_gui_nhnn ts_huu_hinh ts_vo_hinh tai_san_khac
## 0 0 0 0 0 0
## pct_tvnt pct_Tien_gui_NHNN pct_ChoVay_TCTD_khac pct_CK_kinh_doanh pct_CK_dau_tu pct_TS_huu_hinh
## 0 0 0 0 0 0
## pct_TS_vo_hinh pct_TS_khac pct_GopVon g_Tong_TS g_GopVon g_CK
## 0 0 0 1 1 1
## giai_doan quy_mo_ts nhom_tang_truong
## 0 0 1## year tong_tai_san chung_khoan_dau_tu gop_von_dai_han tien_gui_khach_hang cho_vay_cac_tctd_khac
## 0 0 0 0 0 0
## chung_khoan_kinh_doanh tien_vang_ngoai_te tien_gui_nhnn ts_huu_hinh ts_vo_hinh tai_san_khac
## 0 0 0 0 0 0
## pct_tvnt pct_Tien_gui_NHNN pct_ChoVay_TCTD_khac pct_CK_kinh_doanh pct_CK_dau_tu pct_TS_huu_hinh
## 0 0 0 0 0 0
## pct_TS_vo_hinh pct_TS_khac pct_GopVon g_Tong_TS g_GopVon g_CK
## 0 0 0 10 10 10
## giai_doan quy_mo_ts nhom_tang_truong
## 0 0 10Giải thích code: (1) tính tổng số giá trị bị thiếu (NA) trong từng cột → kết quả lưu vào biến na_count. (2) làm tròn tỷ lệ NA đến hai chữ số thập phân để dễ đọc. Cuối cùng, na_count và na_rate được in ra để xem số lượng và tỷ lệ NA của từng biến.
Nhận xét: Kết quả cho thấy hầu hết các biến trong bộ dữ liệu của Ngân hàng SHB giai đoạn 2014–2023 không có giá trị bị thiếu (NA = 0), ngoại trừ một vài biến như g_Tong_TS, g_GopVon, g_CK, nhom_tang_truong, nhom_ck có giá trị bị thiếu ở 1 quan sát, tương ứng với tỷ lệ rất nhỏ (≈ 10%) trong toàn bộ mẫu. Do có dữ liệu chỉ lấy từ năm 2014 nên không có dữ liệu cho năm trước đó nên bị NA (vì không thể tính tốc độ tăng so với năm trước).
2.3.1.5 Phát hiện giá trị ngoại lai tổng tài sản theo quy tắc IQR
Mục đích là phát hiện các giá trị ngoại lai (outlier) của biến Tổng tài sản (tong_tai_san) trong bộ dữ liệu của Ngân hàng SHB, dựa trên quy tắc IQR (Interquartile Range Rule).
q1 <- quantile(shb1$tong_tai_san, 0.25, na.rm = TRUE)
q3 <- quantile(shb1$tong_tai_san, 0.75, na.rm = TRUE)
lower <- q1 - 1.5 * (q3 - q1)
upper <- q3 + 1.5 * (q3 - q1)
out_ts <- shb1 %>%
dplyr::filter(tong_tai_san < lower | tong_tai_san > upper) %>%
dplyr::select(year, tong_tai_san)
out_ts## # A tibble: 0 × 2
## # ℹ 2 variables: year <dbl>, tong_tai_san <dbl>Giải thích code: (1) (2) lần lượt là phân vị thứ 25% và 75% của biến tong_tai_san; (3) (4) (q3 - q1) là IQR (Interquartile Range) – khoảng tứ phân vị thể hiện mức độ phân tán của dữ liệu trung tâm; (6) lọc ra các giá trị ngoài khoảng [lower, upper].(7) chỉ hiển thị năm và tổng tài sản của các giá trị bị phát hiện là ngoại lai.
Nhận xét : Không có giá trị ngoại lai trong biến Tổng tài sản, cho thấy dữ liệu giai đoạn 2014–2023 ổn định và không biến động bất thường. SHB tăng trưởng đều đặn, không có năm tăng/giảm đột biến, phản ánh sự ổn định tài chính và mở rộng hợp lý.
2.3.2 Phân tích tỷ trọng và xu hướng
2.3.2.1 3 năm có tổng tài sản cao nhất
top_ts <- shb1 %>% dplyr::arrange(dplyr::desc(tong_tai_san)) %>%
dplyr::select(year, tong_tai_san) %>%
dplyr::slice_head(n = 3)
top_ts_view <- top_ts %>%
dplyr::transmute(
`Năm` = year,
`Tổng tài sản` = formatC(tong_tai_san, format = "f",
digits = 0, big.mark = ".", decimal.mark = ","))
print(top_ts_view, row.names = FALSE)## # A tibble: 3 × 2
## Năm `Tổng tài sản`
## <dbl> <chr>
## 1 2023 630.500.685.000.000
## 2 2022 550.904.120.000.000
## 3 2021 506.604.328.000.000Câu lệnh: (1) Sắp xếp giảm dần theo tong_tai_san, giữ 2 cột year và tong_tai_san, lấy 3 năm lớn nhất. Kết quả vẫn numeric để tính tiếp. (4) Tạo bản hiển thị: đổi tên cột sang tiếng Việt và định dạng số với dấu chấm ngăn cách nghìn, phẩy thập phân (không đổi dữ liệu gốc). (9) In bảng
Nhận xét: : Top 3 năm có Tổng tài sản cao nhất lần lượt là 2023 (≈ 630,5 nghìn tỷ), 2022 (≈ 550,9 nghìn tỷ) và 2021 (≈ 506,6 nghìn tỷ) — đều thuộc giai đoạn cuối chuỗi, thể hiện xu hướng mở rộng quy mô mạnh mẽ của SHB.
2.3.2.2 3 năm có tỷ trọng chứng khoán đầu tư cao nhất
top_ck <- shb1 %>%
dplyr::arrange(dplyr::desc(pct_CK_dau_tu)) %>%
dplyr::select(year, pct_CK_dau_tu) %>%
utils::head(3) %>%
dplyr::rename(`Năm` = year, `Tỷ lệ CK đầu tư` = pct_CK_dau_tu) %>%
dplyr::mutate(`Tỷ lệ CK đầu tư` = format(`Tỷ lệ CK đầu tư`,
big.mark = ".",
decimal.mark = ",",
scientific = FALSE))
top_ck## # A tibble: 3 × 2
## Năm `Tỷ lệ CK đầu tư`
## <dbl> <chr>
## 1 2018 "14,856322"
## 2 2015 " 8,459356"
## 3 2016 " 8,055912"Giải thích code: (2) là sắp xếp các năm theo thứ tự giảm dần của biến pct_CK_dau_tu (tỷ trọng chứng khoán đầu tư). (3) là giữ lại hai cột cần hiển thị: năm và tỷ trọng chứng khoán đầu tư.(4) là lấy 3 dòng đầu tiên, tức là 3 năm có tỷ trọng chứng khoán đầu tư cao nhất.
Nhận xét: : Tỷ trọng chứng khoán đầu tư cao năm 2018 phản ánh chiến lược mở rộng danh mục tài chính trong giai đoạn thị trường thuận lợi và lãi suất ổn định. Giai đoạn 2015–2016 cho thấy xu hướng đa dạng hóa tài sản, tận dụng cơ hội sinh lời ngắn hạn. Sau đó, trước biến động kinh tế và dịch COVID-19, SHB chuyển hướng sang an toàn vốn và thanh khoản, giảm dần đầu tư tài chính.
2.3.2.3 Tỷ trọng bình quân các cấu phần
w_avg <- shb1 %>% summarise(
w_gopvon = mean(pct_GopVon, na.rm = TRUE),
w_ckdt = mean(pct_CK_dau_tu, na.rm = TRUE),
w_ckkd = mean(pct_CK_kinh_doanh, na.rm = TRUE),
w_tvnt = mean(pct_tvnt, na.rm = TRUE),
w_tgnhnn = mean(pct_Tien_gui_NHNN, na.rm = TRUE),
w_tshh = mean(pct_TS_huu_hinh, na.rm = TRUE),
w_tsvh = mean(pct_TS_vo_hinh, na.rm = TRUE),
w_tskhac = mean(pct_TS_khac, na.rm = TRUE))
w_avg_long <- w_avg %>%
rename(`Tỷ lệ Góp vốn` = w_gopvon,
`Tỷ lệ CK đầu tư` = w_ckdt,
`Tỷ lệ CK kinh doanh` = w_ckkd,
`Tỷ lệ TVNT` = w_tvnt,
`Tỷ lệ Tiền gửi NHNN` = w_tgnhnn,
`Tỷ lệ Tài sản hữu hình` = w_tshh,
`Tỷ lệ Tài sản vô hình` = w_tsvh,
`Tỷ lệ Tài sản khác` = w_tskhac) %>%
pivot_longer(everything(),names_to = "Chỉ tiêu",
values_to = "Giá trị") %>%
mutate(`Giá trị` = formatC(`Giá trị`,
format = "f",
digits = 2,
big.mark = ".",
decimal.mark = ","))
w_avg_long## # A tibble: 8 × 2
## `Chỉ tiêu` `Giá trị`
## <chr> <chr>
## 1 Tỷ lệ Góp vốn 0,07
## 2 Tỷ lệ CK đầu tư 7,56
## 3 Tỷ lệ CK kinh doanh 0,13
## 4 Tỷ lệ TVNT 0,49
## 5 Tỷ lệ Tiền gửi NHNN 2,86
## 6 Tỷ lệ Tài sản hữu hình 0,15
## 7 Tỷ lệ Tài sản vô hình 1,27
## 8 Tỷ lệ Tài sản khác 7,77Giải thích code: (1) Tính các giá trị bình quân. (10) đổi tên các biến kỹ thuật sang tên tiếng Việt dễ đọc. (20) xoay rộng → dọc: gộp tất cả các cột thành hai cột – một cột tên chỉ tiêu và một cột giá trị.
Nhận xét: Hai nhóm chứng khoán đầu tư (7,56%) và tài sản khác (7,77%) chiếm tỷ trọng lớn nhất, thể hiện vai trò quan trọng trong cơ cấu tài sản. Tiền gửi NHNN (2,86%) ổn định, phản ánh nhu cầu thanh khoản. Các khoản khác dưới 2% cho thấy mức đầu tư thận trọng.
2.3.2.4 Tốc độ tăng trưởng YoY bình quân (một số cấu phần)
yoy_avg <- shb1 %>% dplyr::summarise(
yoy_ts = mean(g_Tong_TS, na.rm = TRUE),
yoy_gv = mean(g_GopVon, na.rm = TRUE),
yoy_ck = mean(g_CK, na.rm = TRUE) )
yoy_long <- yoy_avg %>%
dplyr::rename(
`Tăng trưởng TS (YoY, %)` = yoy_ts,
`Tăng trưởng Góp vốn (YoY, %)` = yoy_gv,
`Tăng trưởng CK đầu tư (YoY, %)` = yoy_ck) %>%
tidyr::pivot_longer(dplyr::everything(),
names_to = "Chỉ tiêu", values_to = "Giá trị") %>%
dplyr::mutate(`Giá trị (%)` = scales::label_number(accuracy = 0.01, big.mark = ".", decimal.mark = ",", suffix = " %")(`Giá trị`)) %>%
dplyr::select(`Chỉ tiêu`, `Giá trị (%)`)
yoy_long## # A tibble: 3 × 2
## `Chỉ tiêu` `Giá trị (%)`
## <chr> <chr>
## 1 Tăng trưởng TS (YoY, %) 15,84 %
## 2 Tăng trưởng Góp vốn (YoY, %) 71,70 %
## 3 Tăng trưởng CK đầu tư (YoY, %) 18,90 %Giải thích code: (1) Tính các giá trị bình quân. (6) đổi tên các biến kỹ thuật sang tên tiếng Việt dễ đọc. (12) xoay rộng → dọc: gộp tất cả các cột thành hai cột – một cột tên chỉ tiêu và một cột giá trị.
Nhận xét: : Tổng tài sản của SHB tăng trung bình 15,84%/năm, phản ánh mức tăng cao và ổn định đối với một ngân hàng thương mại, cho thấy xu hướng mở rộng quy mô liên tục. Trong đó, góp vốn dài hạn có tốc độ tăng đột biến (~71,7%/năm), vượt xa các cấu phần khác, thể hiện giai đoạn đẩy mạnh đầu tư vào công ty con, công ty liên kết và góp vốn chiến lược. Bên cạnh đó, chứng khoán đầu tư cũng tăng đều với mức trung bình ~18,9%/năm, cho thấy SHB ngày càng đa dạng hóa hoạt động đầu tư tài chính song song với hoạt động tín dụng truyền thống.
2.3.2.5 Tốc độ tăng trưởng kép (CAGR) của các cấu phần tài sản
cagr <- function(x) {x <- stats::na.omit(x)
if (length(x) < 2) return(NA_real_)
n <- length(x)
(x[n] / x[1])^(1/(n-1)) - 1}
cagr_tbl <- tibble::tibble(
`Chỉ tiêu` = c("Tổng tài sản", "Góp vốn dài hạn", "Chứng khoán đầu tư"),
CAGR = c(
cagr(shb1$tong_tai_san),
cagr(shb1$gop_von_dai_han),
cagr(shb1$chung_khoan_dau_tu))) %>%
dplyr::mutate(`CAGR (%)` = scales::label_percent(accuracy = 0.01, big.mark = ".", decimal.mark = ",")(CAGR)) %>% dplyr::select(`Chỉ tiêu`, `CAGR (%)`)
cagr_tbl## # A tibble: 3 × 2
## `Chỉ tiêu` `CAGR (%)`
## <chr> <chr>
## 1 Tổng tài sản 15,75%
## 2 Góp vốn dài hạn 2,88%
## 3 Chứng khoán đầu tư 10,11%Giải thích code: (1) Định nghĩa hàm cagr(), bỏ NA trong chuỗi; (2) Nếu chuỗi < 2 giá trị → trả về NA; (3) Lưu độ dài chuỗi n; (4) Tính CAGR; (5) Tạo bảng kết quả (tibble).
Nhận xét:
Tổng tài sản tăng mạnh và ổn định, phản ánh mở rộng quy mô 2014–2023. Chứng khoán đầu tư có CAGR ~10%, cho thấy đẩy mạnh đầu tư tài chính; Góp vốn dài hạn chỉ ~2,9%/năm, thể hiện sự thận trọng.
=> Phù hợp bối cảnh ngành: ưu tiên mở rộng tài sản, tín dụng và đầu tư CK để đa dạng thu nhập, đảm bảo thanh khoản, trong khi giữ đầu tư dài hạn ở mức an toàn để kiểm soát rủi ro vốn.
2.3.2.6 Tỷ trọng trung vị của góp vốn theo giai đoạn
Mục tiêu là xem xét liệu tỷ trọng đầu tư góp vốn của Ngân hàng SHB có xu hướng thay đổi theo thời gian hay không. Việc sử dụng trung vị (median) thay vì trung bình giúp kết quả ít bị ảnh hưởng bởi giá trị cực đoan, phản ánh chính xác hơn xu hướng điển hình của mỗi giai đoạn.
med_gv_gd <- shb1 %>% dplyr::group_by(`Giai đoạn` = giai_doan) %>%
dplyr::summarise(p_med = median(pct_GopVon, na.rm = TRUE),.groups = "drop") %>%
dplyr::mutate(`Tỷ trọng trung vị góp vốn dài hạn (%)` =
scales::percent(p_med, accuracy = 0.01, decimal.mark = ",", big.mark = ".")) %>%
dplyr::select(`Giai đoạn`, `Tỷ trọng trung vị góp vốn dài hạn (%)`)
med_gv_gd## # A tibble: 2 × 2
## `Giai đoạn` `Tỷ trọng trung vị góp vốn dài hạn (%)`
## <chr> <chr>
## 1 2014-2018 9,53%
## 2 2019-2023 3,23%Giải thích code: (1) Nhóm dữ liệu theo biến giai_doan. (2) Tính trung vị tỷ trọng góp vốn dài hạn cho từng nhóm. (3) Tạo cột mới định dạng phần trăm theo chuẩn VN
Nhận xét:
Tỷ trọng trung vị góp vốn dài hạn giảm mạnh từ ~9,5% (2014–2018) xuống ~3,2% (2019–2023), cho thấy xu hướng thu hẹp đầu tư dài hạn. Việc dùng trung vị giúp loại bỏ ảnh hưởng của các năm biến động bất thường.
Giai đoạn đầu, SHB mở rộng đầu tư vào công ty con và lĩnh vực ngoài ngân hàng; sau 2019, ngân hàng tập trung vào hoạt động cốt lõi như cho vay và đầu tư chứng khoán, phù hợp xu hướng tăng hiệu quả vốn, thanh khoản và tuân thủ Basel II.
2.3.2.7 Tỷ trọng tiền gửi NHNN trung bình theo nhóm quy mô
w_tgnhnn_vn <- shb1 %>%
group_by(quy_mo_ts) %>%
summarise(`Tỷ lệ tiền gửi NHNN TB (%)` = mean(pct_Tien_gui_NHNN, na.rm = TRUE),
.groups = "drop") %>%
rename(`Quy mô tài sản (nhóm)` = quy_mo_ts) %>%
mutate(`Tỷ lệ tiền gửi NHNN TB (%)` = label_number(
accuracy = 0.01, big.mark = ".", decimal.mark = ",", suffix = " %")(`Tỷ lệ tiền gửi NHNN TB (%)`))
w_tgnhnn_vn## # A tibble: 4 × 2
## `Quy mô tài sản (nhóm)` `Tỷ lệ tiền gửi NHNN TB (%)`
## <fct> <chr>
## 1 [1,69e+14,2,47e+14] 1,76 %
## 2 (2,47e+14,3,44e+14] 1,32 %
## 3 (3,44e+14,4,83e+14] 3,19 %
## 4 (4,83e+14,6,31e+14] 4,76 %Giải thích code: (2) nhóm dữ liệu theo biến quy_mo_ts; (3) tạo bảng tóm tắt với 1 dòng cho mỗi nhóm quy mô, tính tỷ trọng trung bình của tiền gửi NHNN trong tổng tài sản cho từng nhóm; na.rm = TRUE giúp bỏ qua các giá trị bị thiếu.
Nhận xét: Bảng cho thấy tỷ lệ tiền gửi tại NHNN của SHB tăng dần theo quy mô tổng tài sản. Ở nhóm nhỏ nhất (169–247 nghìn tỷ đồng), tỷ lệ trung bình chỉ 1,76%, sau đó giảm nhẹ (1,32%) rồi tăng mạnh ở các nhóm lớn hơn (3,19% và 4,76%). Xu hướng này cho thấy khi quy mô tài sản mở rộng, SHB có xu hướng gia tăng dự trữ tại NHNN để đảm bảo an toàn thanh khoản và tuân thủ quy định dự trữ bắt buộc, phản ánh chính sách quản trị thận trọng hơn trong giai đoạn tăng trưởng.
2.3.2.8 Tỷ trọng chứng khoán đầu tư trung bình theo nhóm quy mô
w_ck_quymo_vn <- shb1 %>%
group_by(quy_mo_ts) %>%
summarise(`Tỷ lệ CK đầu tư TB (%)` = mean(pct_CK_dau_tu, na.rm = TRUE),
.groups = "drop") %>%
rename(`Quy mô tài sản (nhóm)` = quy_mo_ts) %>%
mutate(`Tỷ lệ CK đầu tư TB (%)` = label_number(
accuracy = 0.01, big.mark = ".", decimal.mark = ",", suffix = " %")(`Tỷ lệ CK đầu tư TB (%)`))
w_ck_quymo_vn## # A tibble: 4 × 2
## `Quy mô tài sản (nhóm)` `Tỷ lệ CK đầu tư TB (%)`
## <fct> <chr>
## 1 [1,69e+14,2,47e+14] 8,16 %
## 2 (2,47e+14,3,44e+14] 11,14 %
## 3 (3,44e+14,4,83e+14] 6,43 %
## 4 (4,83e+14,6,31e+14] 5,34 %Giải thích code: (2) nhóm dữ liệu theo biến quy_mo_ts; (3) tạo bảng tóm tắt với 1 dòng cho mỗi nhóm quy mô, tính tỷ trọng trung bình của chứng khoán đầu tư trong tổng tài sản cho từng nhóm; na.rm = TRUE giúp bỏ qua các giá trị bị thiếu.
Nhận xét Tỷ trọng CKĐT cao nhất ở nhóm quy mô trung bình thấp (~11,14%), giảm còn ~5,34% ở nhóm lớn nhất, cho thấy quy mô tài sản tăng → tỷ trọng CKĐT giảm, ngân hàng tập trung hơn vào cho vay và tài sản sinh lời chính.
2.3.2.9 Tỷ lệ năm có YoY tổng tài sản âm
## [1] 0Giải thích code: shb1g_Tong_TS < 0: tạo một mảng logic, đánh dấu TRUE nếu tăng trưởng âm, FALSE nếu tăng trưởng dương hoặc bằng 0. mean(…, na.rm=TRUE): Khi áp dụng mean() lên một mảng logic, TRUE = 1, FALSE = 0. Do đó, giá trị trung bình chính là tỷ lệ (%) năm có YoY âm.
Nhận xét: Kết quả bằng 0 cho thấy không có năm nào tổng tài sản giảm, tất cả các năm đều tăng trưởng dương (YoY > 0). SHB duy trì tăng trưởng quy mô liên tục và bền vững, thể hiện hiệu quả huy động – đầu tư ổn định và quản trị rủi ro tốt. Xu hướng này phù hợp với ngành ngân hàng Việt Nam, nơi các ngân hàng thương mại vẫn tăng trưởng đều nhờ nhu cầu tín dụng và đầu tư cao.
2.3.3 Phân tích nâng cao và so sánh giai đoạn
2.3.3.1 Hệ số tương quan giữa các loại tài sản
numset <- shb1 %>%dplyr::select(tong_tai_san,gop_von_dai_han,chung_khoan_dau_tu,chung_khoan_kinh_doanh,tien_gui_nhnn,
tien_vang_ngoai_te,cho_vay_cac_tctd_khac,ts_huu_hinh,ts_vo_hinh,tai_san_khac)
cor_mat <- cor(numset, use = "pairwise.complete.obs", method = "pearson")
cor_mat## tong_tai_san gop_von_dai_han chung_khoan_dau_tu chung_khoan_kinh_doanh tien_gui_nhnn tien_vang_ngoai_te cho_vay_cac_tctd_khac
## tong_tai_san 1,0000000 -0,1909627 0,5109094 0,58926743 0,80204841 0,3591603 -0,29625936
## gop_von_dai_han -0,1909627 1,0000000 -0,2353983 0,65521771 0,40461442 -0,5559915 0,31130434
## chung_khoan_dau_tu 0,5109094 -0,2353983 1,0000000 0,21056706 0,28881177 0,4977523 -0,66476966
## chung_khoan_kinh_doanh 0,5892674 0,6552177 0,2105671 1,00000000 0,94296183 -0,2117598 -0,03244406
## tien_gui_nhnn 0,8020484 0,4046144 0,2888118 0,94296183 1,00000000 -0,0374352 -0,06135768
## tien_vang_ngoai_te 0,3591603 -0,5559915 0,4977523 -0,21175984 -0,03743520 1,0000000 -0,25083198
## cho_vay_cac_tctd_khac -0,2962594 0,3113043 -0,6647697 -0,03244406 -0,06135768 -0,2508320 1,00000000
## ts_huu_hinh 0,8905725 0,1485433 0,4974447 0,81494539 0,92990040 0,1022471 -0,27815290
## ts_vo_hinh 0,8444237 -0,3273695 0,6469484 0,35008344 0,59246994 0,4822409 -0,28314405
## tai_san_khac 0,8667142 -0,5227235 0,3703854 0,21594431 0,47749652 0,4595880 -0,32558128
## ts_huu_hinh ts_vo_hinh tai_san_khac
## tong_tai_san 0,8905725 0,8444237 0,8667142
## gop_von_dai_han 0,1485433 -0,3273695 -0,5227235
## chung_khoan_dau_tu 0,4974447 0,6469484 0,3703854
## chung_khoan_kinh_doanh 0,8149454 0,3500834 0,2159443
## tien_gui_nhnn 0,9299004 0,5924699 0,4774965
## tien_vang_ngoai_te 0,1022471 0,4822409 0,4595880
## cho_vay_cac_tctd_khac -0,2781529 -0,2831440 -0,3255813
## ts_huu_hinh 1,0000000 0,7594434 0,5663420
## ts_vo_hinh 0,7594434 1,0000000 0,7206228
## tai_san_khac 0,5663420 0,7206228 1,0000000Giải thích code: (2) chọn ra các cột (biến) định lượng cần tính tương qua; (3) tính ma trận hệ số tương quan Pearson giữa các biến số trong numset.
Nhận xét:
Tổng tài sản tương quan dương mạnh với tài sản vô hình (0,84), tài sản khác (0,87) và tiền gửi NHNN (0,80), cho thấy quy mô mở rộng đi kèm tăng dự trữ và đầu tư phi tài chính.
Chứng khoán đầu tư dương với chứng khoán kinh doanh (0,65) nhưng âm với cho vay TCTD khác (-0,66), phản ánh sự điều chỉnh linh hoạt trong danh mục tài chính. Góp vốn dài hạn dương với chứng khoán kinh doanh (0,65) nhưng âm với tài sản ngắn hạn, cho thấy xu hướng ngược chiều đầu tư dài hạn – thanh khoản.
=> Giai đoạn 2014–2023, SHB mở rộng quy mô bằng cách tăng đồng thời nhiều nhóm tài sản, đặc biệt chứng khoán đầu tư, tiền gửi NHNN và tài sản khác, thể hiện cơ cấu tài sản phát triển đồng bộ và linh hoạt.
2.3.3.2 Phân vị (10%, 90%) tổng tài sản
Tính phân vị 10% (P10) và 90% (P90) của biến Tổng tài sản giúp xác định ngưỡng dưới – trên của phân bố tài sản, qua đó đánh giá mức biến động và chênh lệch quy mô trong giai đoạn 2014–2023.
p10 <- quantile(shb1$tong_tai_san, 0.10, na.rm = TRUE)
p90 <- quantile(shb1$tong_tai_san, 0.90, na.rm = TRUE)
fmt_vn <- function(x, digits = 0){
formatC(x, format = "f", digits = digits, big.mark = ".", decimal.mark = ",")}
cat("P10: ", fmt_vn(p10), "\n",
"P90: ", fmt_vn(p90), "\n", sep = "")## P10: 201.137.280.600.000
## P90: 558.863.776.500.000Giải thích code: (1) (2) là hàm dùng để tính giá trị phân vị của một biến số. (4) Định dạng lại số chuẩn VN
Nhận xét: Khoảng cách lớn giữa P90 và P10 (>35.000 tỷ) cho thấy tổng tài sản SHB biến động mạnh và tăng rõ rệt qua thời gian. Các năm 2014–2015 nằm dưới P10 (~20 nghìn tỷ), còn 2021–2023 vượt P90 (55 nghìn tỷ), phản ánh quá trình mở rộng quy mô nhanh. SHB đã tăng trưởng vượt bậc trong 10 năm, đặc biệt sau 2020 khi đẩy mạnh tín dụng và đầu tư chứng khoán. Khoảng phân vị rộng thể hiện tốc độ tăng nhanh, không đồng đều, nhưng là dấu hiệu tích cực cho thấy ngân hàng vươn lên nhóm có quy mô lớn, củng cố vị thế cạnh tranh.
2.3.3.3 Năm có biến động YoY mạnh nhất
max_vol_year <- shb1 %>%dplyr::filter(abs(g_Tong_TS) == max(abs(g_Tong_TS), na.rm = TRUE)) %>%
dplyr::select(year, g_Tong_TS) %>%
dplyr::rename(
`Năm` = year,
`Tăng trưởng TS lớn nhất (YoY, %)` = g_Tong_TS) %>%
dplyr::mutate(`Tăng trưởng TS lớn nhất (YoY, %)` = formatC(
`Tăng trưởng TS lớn nhất (YoY, %)`,
format = "f", digits = 2, big.mark = ".", decimal.mark = ","))
max_vol_year## # A tibble: 1 × 2
## Năm `Tăng trưởng TS lớn nhất (YoY, %)`
## <dbl> <chr>
## 1 2021 22,76Giải thích code: (1) lấy giá trị tuyệt đối của tốc độ tăng trưởng tổng tài sản để xét độ lớn của biến động, lọc ra hàng (năm) có giá trị biến động lớn nhất. (3) chỉ hiển thị hai cột cần thiết là năm và tốc độ tăng trưởng tổng tài sản. (4) Đổi tên cho cột
Kết quả cho thấy: Năm 2021 có biến động YoY mạnh nhất, với tăng trưởng tổng tài sản ~22,8%, phản ánh sự mở rộng đột biến quy mô nhờ tăng huy động, cho vay và đầu tư chứng khoán. Giai đoạn hậu COVID-19, SHB hưởng lợi từ chính sách tiền tệ nới lỏng, mở rộng tín dụng và đầu tư, đồng thời tăng vốn điều lệ, giúp tổng tài sản tăng vượt trội, thể hiện sức bật và năng lực mở rộng thị phần sau tái cơ cấu.
2.3.3.4 So sánh trung bình tổng tài sản giữa 2 giai đoạn
tt_gd_vn <- shb1 %>%
group_by(giai_doan) %>%
summarise(`Tổng tài sản TB` = mean(tong_tai_san, na.rm = TRUE),
.groups="drop") %>%
rename(`Giai đoạn` = giai_doan) %>%
mutate(`Tổng tài sản TB` = label_number(
accuracy = 1, big.mark = ".", decimal.mark = ",")(`Tổng tài sản TB`))
tt_gd_vn## # A tibble: 2 × 2
## `Giai đoạn` `Tổng tài sản TB`
## <chr> <chr>
## 1 2014-2018 243.394.703.000.000
## 2 2019-2023 493.188.608.800.000Giải thích code: (2) chia dữ liệu thành hai nhóm theo giai đoạn thời gian (2014–2018 và 2019–2023). (3) tạo bảng tóm tắt, tính toán giá trị trung bình của tổng tài sản cho từng nhóm, tính giá trị trung bình tổng tài sản trong từng giai đoạn, loại bỏ các giá trị bị thiếu (NA).
Nhận xét: Tổng tài sản trung bình của SHB giai đoạn 2019–2023 tăng hơn gấp đôi (khoảng 102,5%) so với 2014–2018, cho thấy quy mô hoạt động mở rộng rõ rệt. Giai đoạn đầu, ngân hàng chủ yếu xử lý nợ xấu và tái cấu trúc sau sáp nhập Habubank, còn giai đoạn sau đẩy mạnh cho vay, đầu tư và tăng vốn, giúp tài sản tăng nhanh. Xu hướng này phù hợp với diễn biến toàn ngành, đặc biệt sau 2020 khi chính sách lãi suất thấp và hỗ trợ tín dụng thúc đẩy tăng trưởng mạnh.
2.3.3.5 Nhóm tài sản có tỷ trọng bình quân cao nhất mỗi năm
w_top3_by_year <- shb1 %>%dplyr::select(year, pct_GopVon, pct_CK_dau_tu, pct_CK_kinh_doanh, pct_tvnt,pct_Tien_gui_NHNN, pct_TS_huu_hinh, pct_TS_vo_hinh, pct_TS_khac) %>%
tidyr::pivot_longer(-year, names_to = "part", values_to = "w") %>%
dplyr::group_by(year, part) %>%
dplyr::summarise(w = mean(w, na.rm = TRUE), .groups = "drop") %>%
dplyr::group_by(year) %>%
dplyr::slice_max(order_by = w, n = 1, with_ties = FALSE) %>%
dplyr::arrange(year, dplyr::desc(w)) %>%
dplyr::mutate(
`Chỉ tiêu` = dplyr::recode(
part,
pct_GopVon = "Góp vốn dài hạn",
pct_CK_dau_tu = "CK đầu tư",
pct_CK_kinh_doanh = "CK kinh doanh",
pct_tvnt = "TVNT",
pct_Tien_gui_NHNN = "Tiền gửi NHNN",
pct_TS_huu_hinh = "Tài sản hữu hình",
pct_TS_vo_hinh = "Tài sản vô hình",
pct_TS_khac = "Tài sản khác"),
`Năm` = year,
`Tỷ lệ TB (%)` = scales::label_number(
accuracy = 0.01, big.mark = ".", decimal.mark = ",", suffix = " %")(w)) %>%
dplyr::select(`Năm`, `Chỉ tiêu`, `Tỷ lệ TB (%)`)
w_top3_by_year## # A tibble: 10 × 4
## # Groups: year [10]
## year Năm `Chỉ tiêu` `Tỷ lệ TB (%)`
## <dbl> <dbl> <chr> <chr>
## 1 2014 2014 Tài sản khác 8,51 %
## 2 2015 2015 CK đầu tư 8,46 %
## 3 2016 2016 CK đầu tư 8,06 %
## 4 2017 2017 Tài sản khác 9,21 %
## 5 2018 2018 CK đầu tư 14,86 %
## 6 2019 2019 Tài sản khác 8,45 %
## 7 2020 2020 Tài sản khác 7,03 %
## 8 2021 2021 Tài sản khác 7,50 %
## 9 2022 2022 Tài sản khác 9,81 %
## 10 2023 2023 Tiền gửi NHNN 8,69 %Giải thích code: (1) chỉ chọn các biến cần thiết — gồm year (năm) và các biến tỷ trọng từng loại tài sản. (2) Chuyển bảng dữ liệu từ dạng “rộng” (nhiều cột) sang “dài” (2 cột: loại tài sản và tỷ trọng). (3) nhóm dữ liệu theo năm và loại tài sản. (4) tính tỷ trọng trung bình của từng loại tài sản trong mỗi năm (bỏ qua giá trị NA).(8) Đổi tên cột thành tiếng Việt
Nhận xét:
Cấu phần dẫn đầu thay đổi qua các năm, luân phiên giữa “Tài sản khác”, “CK đầu tư” và “Tiền gửi NHNN”. “Tài sản khác” chiếm ưu thế ở hầu hết các năm, “CK đầu tư” nổi bật giai đoạn 2015–2018 (đỉnh 2018: ~14,86%), còn “Tiền gửi NHNN” dẫn đầu 2023 (~8,69%). Mức Top-1 dao động 7–10%, cho thấy cơ cấu đa dạng, không có khoản mục thống trị.
Giai đoạn 2015–2018, “CK đầu tư” tăng mạnh nhờ thị trường vốn thuận lợi; 2019–2023, xu hướng chuyển sang “Tài sản khác” và “Tiền gửi NHNN”, phản ánh chiến lược tăng thanh khoản, giảm rủi ro trong môi trường lãi suất biến động.
2.3.3.6 Hệ số biến thiên theo giai đoạn
Hệ số biến thiên (CV) giúp xác định mức độ biến động tương đối của tổng tài sản so với giá trị trung bình. → CV càng nhỏ → dữ liệu càng ổn định, ít dao động → cho thấy ngân hàng quản lý tài sản hiệu quả và duy trì quy mô bền vững hơn
cv_by_gd_vn <- shb1 %>%
group_by(giai_doan) %>% summarise(`Hệ số biến thiên TS` = sd(tong_tai_san, na.rm = TRUE) /
mean(tong_tai_san, na.rm = TRUE),
.groups = "drop") %>%
rename(`Giai đoạn` = giai_doan) %>%
mutate(`Hệ số biến thiên TS` = label_number(
accuracy = 0.0001, big.mark = ".", decimal.mark = ",")(`Hệ số biến thiên TS`))
cv_by_gd_vn## # A tibble: 2 × 2
## `Giai đoạn` `Hệ số biến thiên TS`
## <chr> <chr>
## 1 2014-2018 0,2542
## 2 2019-2023 0,2156Giải thích code:(2) Tính tóm tắt cho từng nhóm giai đoạn: độ lệch chuẩn, giá trị trung bình của tổng tài sản trong giai đoạn. Hàm cv_ts = sd(…) / mean(…): công thức tính hệ số biến thiên (CV).
Nhận xét: Hệ số biến thiên CV 2014–2018 = 0,2542 cao hơn CV 2019–2023 = 0,2156, cho thấy tổng tài sản giai đoạn sau ổn định hơn và dao động quanh trung bình ít hơn. Mức giảm khoảng 15% phản ánh sự ổn định tăng dần trong quản trị và mở rộng quy mô.
2.4 Trực quan hoá dữ liệu
2.4.1 Cấu trúc và biến động theo thời gian
2.4.1.1 Cơ cấu tài sản theo năm
lab_pct <- label_percent(accuracy = .1, big.mark = ".", decimal.mark = ",")
end <- long %>% filter(year == max(year, na.rm = TRUE)) %>%
summarise(ty = first(ty_trong), .by = khoan_muc)
legend_breaks <- end$khoan_muc
legend_labels <- setNames(paste0(end$khoan_muc, " (", percent(end$ty, accuracy = 0.1,big.mark = ".", decimal.mark = ","), ")"),end$khoan_muc)
ggplot(long, aes(year, ty_trong, fill = khoan_muc)) +
geom_area(color = "white", linewidth = .2, alpha = .95) +
scale_y_continuous(labels = lab_pct, expand = expansion(mult = c(0, .02))) +
scale_x_continuous(breaks = unique(long$year)) +
scale_fill_brewer(palette = "Pastel1", name = "Khoản mục",labels = legend_labels, breaks = legend_breaks) +
labs(title = toupper("Cơ cấu tài sản theo năm"),x = "Năm", y = "Tỷ trọng trong tổng tài sản") +
theme_minimal(base_family = "Times New Roman") +
theme(legend.position = "right",panel.grid.minor = element_blank(),plot.title = element_text(hjust = 0.4, face = "bold"),plot.title.position = "plot")
Câu lệnh: (3) Lấy tỷ trọng đầu tiên theo từng “khoản mục” ở năm mới nhất để làm nhãn; (6) Khởi tạo biểu đồ area; (7) Vẽ vùng diện tích; viền trắng mảnh, độ trong suốt cao; (10) Bảng màu Pastel 1; đặt tên legend là “Khoản mục”; dùng nhãn và thứ tự đã tạo; (12) Áp dụng giao diện tối giản với phông Times New Roman; (13) Chỉnh bố cục: legend bên phải, ẩn lưới phụ, tiêu đề đậm căn trái nhẹ; tiêu đề đặt tại vùng đồ thị.
Nhận xét: Năm cuối chuỗi cho thấy “Tiền gửi khách hàng” (~75,8%) chiếm ưu thế tuyệt đối, tiếp theo là “Tiền gửi NHNN” (~9,3%), “CK đầu tư” (~5,4%) và “Tài sản khác” (~6,1%); các nhóm còn lại chiếm tỷ trọng nhỏ (<2%). Cơ cấu này phản ánh mô hình kinh doanh thiên về huy động và tài sản thanh khoản cao, trong đó tiền gửi khách hàng là nguồn vốn chủ đạo.
2.4.1.2 Tỷ trọng từng khoản mục theo thời gian
plot_dat <- long %>% arrange(khoan_muc, year)
span_fac <- plot_dat %>% group_by(khoan_muc) %>% summarise(ymin = min(ty_trong, na.rm = TRUE),ymax = max(ty_trong, na.rm = TRUE),span = ymax - ymin, .groups = "drop")
last_lab <- plot_dat %>% group_by(khoan_muc) %>% filter(year == max(year, na.rm = TRUE)) %>% ungroup() %>% transmute(khoan_muc,x = year,y = ty_trong,lab = percent(ty_trong, accuracy = 0.1,big.mark = ".", decimal.mark = ",")) %>%
left_join(span_fac, by = "khoan_muc") %>% mutate(y_plot = pmin(y + 0.15 + ifelse(span > 0, span, 0.01),ymax + 0.20 * ifelse(span > 0, span, 0.01)))
col_line <- "#1F3A5F"
col_fill <- "#9DC3E6"
lab_pct <- label_percent(accuracy = 0.1, big.mark = ".", decimal.mark = ",")
yr_first <- min(plot_dat$year, na.rm = TRUE)
yr_last <- max(plot_dat$year, na.rm = TRUE)
ggplot(plot_dat, aes(x = year, y = ty_trong, group = khoan_muc)) +
annotate("rect",xmin = 2019 - .5, xmax = yr_last + .5,ymin = -Inf, ymax = Inf, fill = "grey98") +
geom_ribbon(aes(ymin = 0, ymax = ty_trong), fill = col_fill, alpha = 0.16, colour = NA) +
geom_line(colour = col_line, linewidth = 0.9) +
geom_point(colour = col_line, size = 1.6) +
geom_text(data = last_lab,aes(x = x, y = y_plot, label = lab),vjust = 0, fontface = "bold", family = "Times New Roman", size = 2.8, colour = col_line, check_overlap = TRUE) +
facet_wrap(~ khoan_muc, ncol = 3, scales = "free_y",labeller = labeller(khoan_muc = function(x) stringr::str_to_title(x))) +
scale_y_continuous(labels = lab_pct,breaks = scales::breaks_extended(n = 4),
expand = expansion(mult = c(0, 0.5))) +
scale_x_continuous(breaks = seq(yr_first, yr_last, by = 2),
limits = c(yr_first, yr_last + 0.35)) +
labs(title = "TỶ TRỌNG TỪNG KHOẢN MỤC THEO THỜI GIAN",x = "Năm", y = "Tỷ trọng") +
theme_minimal(base_family = "Times New Roman") +
theme(plot.title = element_text(face = "bold", size = 18, hjust = 0.5),
plot.title.position = "plot",strip.text = element_text(face = "plain", size = 10, margin = margin(b = 4)),panel.spacing = grid::unit(16, "pt"),axis.text.x = element_text(size = 8, margin = margin(t = 6)), axis.text.y = element_text(size = 8, colour = "gray25", margin = margin(r = 6)), axis.title = element_text(size = 10),panel.grid.minor = element_blank(), panel.grid.major.x = element_blank(),panel.grid.major.y = element_line(linetype = "dotted", color = "gray80", linewidth = .25), plot.margin = margin(6, 32, 6, 6)) +
coord_cartesian(clip = "off")
Câu lệnh: (1) Sắp xếp theo khoản_mục, năm; (2) Tính ymin, ymax, span; (8–9) Lấy năm đầu & năm cuối; (10) Khởi tạo ggplot: x=năm, y=tỷ trọng, group=khoản_mục; (12–15) Vẽ ribbon, line, point, gắn nhãn % ở năm cuối; (17–20) Chỉnh trục y/x & giới hạn; (21) Tiêu đề + nhãn trục; (22–25) Theme/kiểu chữ/lưới; (26) clip = “off” để nhãn không bị cắt.
Nhận xét: Cơ cấu tài sản của SHB giai đoạn 2014–2023 cho thấy sự ổn định của nguồn vốn huy động và định hướng quản trị an toàn. Tiền gửi khách hàng luôn chiếm tỷ trọng cao 75–80% tổng tài sản, khẳng định vai trò nguồn vốn cốt lõi và niềm tin vững chắc từ người gửi tiền. Từ năm 2021, tiền gửi NHNN và chứng khoán đầu tư tăng rõ rệt – lần lượt đạt gần 10% và 5,4% vào năm 2023, phản ánh chính sách tăng dự trữ thanh khoản và mở rộng đầu tư tài chính nhằm tối ưu lợi suất. Ngược lại, cho vay TCTD khác, tài sản khác và tài sản vô hình giảm mạnh, thể hiện định hướng thu hẹp mảng kém hiệu quả và giảm rủi ro liên ngân hàng. Trong khi đó, góp vốn dài hạn và tài sản hữu hình duy trì ở mức rất nhỏ (0,1–0,2%), cho thấy chiến lược đầu tư thận trọng và tập trung vào hoạt động cốt lõi.
2.4.1.3 Tăng trưởng năm-qua-năm (YoY) theo khoản mục
cap <- quantile(abs(yoy$yoy), 0.95, na.rm = TRUE)
min_lab <- 0.005
lab_pct <- function(x) paste0(formatC(x*100, format="f", digits=1,big.mark=".", decimal.mark=","), "%")
yoy_hm <- yoy %>%dplyr::mutate(yoy_cap = pmax(pmin(yoy, cap), -cap),
lab = dplyr::case_when(is.na(yoy) ~ "",abs(yoy) < min_lab ~ "",yoy > cap ~ paste0("≥", lab_pct(cap)), yoy < -cap~ paste0("≤", lab_pct(cap)), TRUE ~ lab_pct(yoy)),txt_col = ifelse(abs(yoy_cap) >= 0.60*cap, "white", "gray15")) %>%
dplyr::group_by(khoan_muc) %>%
dplyr::mutate(ord = median(yoy_cap, na.rm = TRUE)) %>%
dplyr::ungroup() %>%
dplyr::mutate(khoan_muc = reorder(khoan_muc, ord))
ggplot(yoy_hm, aes(x = factor(year), y = khoan_muc, fill = yoy_cap)) +
geom_tile(color = "white", linewidth = .35) +
geom_text(aes(label = lab, color = txt_col),family = "Times New Roman", size = 3.4, lineheight = .95) +
scale_color_identity() +
scale_fill_gradient2(low = "#b2182b", mid = "white", high = "#2166ac", midpoint = 0,limits = c(-cap, cap),breaks = c(-cap, -cap/2, 0, cap/2, cap),labels = function(x) lab_pct(x),name = "YoY") +
guides(fill = guide_colourbar(barheight = unit(90, "pt"), barwidth = unit(10, "pt"),ticks = TRUE, frame.colour = "grey70")) +
scale_x_discrete(expand = c(0, 0)) +
labs(title = toupper("TĂNG TRƯỞNG CÁC KHOẢN MỤC"),x = "Năm", y = NULL, caption = paste0("Thanh chú giải cắt tại ±", lab_pct(cap), " (95th percentile).")) +
theme_minimal(base_family = "Times New Roman") +
theme(plot.title = element_text(face = "bold", size = 14, margin = margin(b = 8), hjust = 0.5),plot.title.position = "plot",axis.text.x = element_text(size = 9),axis.text.y = element_text(size = 10), panel.grid = element_blank(),plot.caption = element_text(size = 8, hjust = 1))
Câu lệnh:(1) Xác định ngưỡng cắt trên (95%) cho biến tăng trưởng; (2) Đặt giá trị tối thiểu hiển thị; (4) Giới hạn giá trị yoy trong khoảng ±ngưỡng, gán màu chữ theo mức độ; (5) Gom nhóm theo khoản mục và tính vị trí trung vị; (7) Khởi tạo ggplot, trục x = năm, y = khoản mục, fill = tăng trưởng; (11) Giới hạn trục màu trong ±ngưỡng; (14) Dùng theme Times New Roman, tối giản, chữ đậm rõ.
Nhận xét: Cơ cấu tài sản của SHB cho thấy sự phân hóa rõ giữa các nhóm khoản mục. Các khoản mục biến động cao như chứng khoán kinh doanh, cho vay TCTD khác và góp vốn dài hạn phản ánh tính chu kỳ, nhạy cảm với biến động thị trường và chính sách thanh khoản. Các khoản mục ổn định gồm tiền gửi khách hàng – tăng đều 11–23%/năm, là nguồn vốn vững chắc, và chứng khoán đầu tư – biến động vừa phải, đóng vai trò điều tiết thanh khoản. Khoản mục điều tiết là tiền gửi NHNN, tăng đột biến ở 2018 và 2023 khi chính sách tiền tệ thắt chặt. Trong khi đó, các khoản mục nhỏ như tài sản hữu hình, vô hình và tiền–vàng–ngoại tệ ít biến động, nên ảnh hưởng không đáng kể đến tổng tài sản.
2.4.1.4 Chỉ số chuẩn hoá quy mô từng khoản mục (gốc năm 2014)
base_year <- 2014L
df_idx <- long %>%mutate(khoan_muc = str_to_title(khoan_muc)) %>%
group_by(khoan_muc) %>%arrange(year, .by_group = TRUE) %>%
mutate(base_val = {v <- gia_tri[year == base_year]
if (length(v) == 0 || is.na(v[1])) first(gia_tri) else v[1]},index2014 = 100 * gia_tri / base_val ) %>%ungroup()
yr_first <- min(df_idx$year, na.rm = TRUE)
yr_last <- max(df_idx$year, na.rm = TRUE)
end_lab <- df_idx %>%group_by(khoan_muc) %>%
summarise(x = max(year, na.rm = TRUE),y = index2014[which.max(year)],
ymin = min(index2014, na.rm = TRUE),ymax = max(index2014, na.rm = TRUE),
.groups = "drop" ) %>%mutate(span = pmax(ymax - ymin, 0), y_lab = y + pmax(0.12 * span, 2), lab = formatC(y, format = "f", digits = 0,big.mark = ".", decimal.mark = ","))
col_line <- "#8A3A4A"
fill_up <- "#B7E1CD"
fill_dn <- "#F4A7A3"
p_idx <- ggplot(df_idx, aes(year, index2014, group = khoan_muc)) +
geom_ribbon(aes(ymin = pmin(index2014, 100), ymax = 100),fill = fill_dn, alpha = .18, colour = NA) +
geom_ribbon(aes(ymin = 100, ymax = pmax(index2014, 100)),fill = fill_up, alpha = .18, colour = NA) +
geom_hline(yintercept = 100, linetype = "dashed",colour = "gray60", linewidth = .4) + geom_line(colour = col_line, linewidth = 1.0) +
geom_point(colour = col_line, size = 1.8) +
geom_label(data = end_lab,aes(x = x + 0.10, y = y_lab, label = lab), family = "Times New Roman", size = 3,colour = col_line,fill = alpha("white", 0.9),label.size = 0,label.padding = unit(1.2, "pt"),check_overlap = TRUE) +
facet_wrap(~ khoan_muc, ncol = 3, scales = "free_y") +
scale_y_continuous(labels = label_number(accuracy = 1, big.mark = ".", decimal.mark = ","),breaks = breaks_extended(n = 4),expand = expansion(mult = c(0, 0.10))) + scale_x_continuous(breaks = seq(yr_first, yr_last, by = 3),limits = c(yr_first, yr_last + 0.25)) +
labs(title = "CHỈ SỐ CHUẨN HOÁ QUY MÔ TỪNG KHOẢN MỤC",x = "Năm", y = "Index") +
coord_cartesian(clip = "off") +
theme_minimal(base_family = "Times New Roman") +
theme(plot.title = element_text(face = "bold", size = 16,margin = margin(b = 6),hjust=0.5),plot.title.position = "plot",strip.text = element_text(size = 11, margin = margin(b = 4)),panel.spacing = unit(16, "pt"),axis.text.x = element_text(size = 9),axis.text.y = element_text(size = 9, colour = "gray25"),axis.title = element_text(size = 10),
panel.grid.minor = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_line(linetype = "dotted",color = alpha("gray80", 0.6),linewidth = .22),plot.margin = margin(6, 34, 6, 6))
p_idx
Câu lệnh: (1) Chọn năm gốc = 2014 để chuẩn hoá; (3) Sắp theo khoản mục–năm, lấy giá trị năm gốc cho từng khoản; (4) Tạo chỉ số index = 100 tại năm gốc cho mọi chuỗi; (7) Đặt màu: đường; vùng tăng (>100); vùng giảm (<100); (8) Khởi tạo biểu đồ: x = năm, y = index, nhóm theo khoản mục; (16) Đặt tiêu đề/nhãn trục và chú thích; (17) Clip = off để nhãn không bị cắt mép.
Nhận xét: Biểu đồ cho thấy sự khác biệt lớn về tốc độ tăng quy mô giữa các khoản mục của SHB giai đoạn 2014–2023. Chứng khoán kinh doanh tăng đột biến nhất (hơn 24.000 lần), phản ánh giai đoạn mở rộng mạnh danh mục đầu tư ngắn hạn. Tiền gửi NHNN cũng tăng nhanh (≈1.637 điểm), thể hiện chính sách tăng dự trữ thanh khoản. Tiền gửi khách hàng tăng đều (≈363 điểm), đóng vai trò trụ cột ổn định. Ngược lại, Cho vay TCTD khác giảm xuống còn 57 điểm, cho thấy xu hướng thu hẹp liên ngân hàng. Các khoản khác như chứng khoán đầu tư, góp vốn dài hạn, tài sản hữu hình, vô hình và tiền–ngoại tệ đều tăng vừa phải, phản ánh sự mở rộng có kiểm soát trong cơ cấu tài sản.
2.4.1.5 Tăng trưởng tổng tài sản giai đoạn 2014–2023 (CAGR & YoY)
stopifnot(exists("shb1"))
nm <- names(shb1)
lwr <- tolower(nm)
cand <- which(str_detect(lwr, "tong") & str_detect(lwr, "tai") & str_detect(lwr, "san"))
stopifnot(length(cand) >= 1)
col_ts <- nm[cand[1]]
stopifnot("year" %in% names(shb1))
total <- shb1 %>%
transmute(year, tong_ts = .data[[col_ts]]) %>%
arrange(year) %>%
mutate(yoy = (tong_ts / lag(tong_ts) - 1))
lab_num <- label_number(big.mark=".", decimal.mark=",")
lab_pct <- label_percent(accuracy = 0.1, big.mark=".", decimal.mark=",")
yr_first <- min(total$year, na.rm=TRUE)
yr_last <- max(total$year, na.rm=TRUE)
cut_year <- yr_first + 4L
cagr <- function(v0, v1, n) (v1/v0)^(1/n) - 1
cagr1 <- cagr(total$tong_ts[total$year==yr_first],total$tong_ts[total$year==cut_year],cut_year-yr_first)
cagr2 <- cagr(total$tong_ts[total$year==(cut_year+1)],total$tong_ts[total$year==yr_last],yr_last-(cut_year+1))
scale_fac <- max(total$tong_ts, na.rm=TRUE)
p_min <- total %>% slice_min(tong_ts, n=1)
p_max <- total %>% slice_max(tong_ts, n=1)
lab_num_nty <- function(x) scales::label_number(big.mark=".", decimal.mark=",")(x / 1e12)
end_labels <- total %>%filter(year %in% c(yr_first, yr_last)) %>%
mutate(label = dplyr::case_when(year %in% c(p_min$year, p_max$year) ~ NA_character_,TRUE ~ lab_num_nty(tong_ts))) %>% filter(!is.na(label))
rng <- diff(range(total$tong_ts, na.rm = TRUE))
up_n <- -0.22
ggplot(total, aes(year, tong_ts)) +
annotate("rect", xmin=yr_first-.5, xmax=cut_year+.5, ymin=-Inf, ymax=Inf,
fill="#EEF3F8", alpha=.70) +
annotate("rect", xmin=cut_year+.5, xmax=yr_last+.5, ymin=-Inf, ymax=Inf,
fill="#FFF7C9", alpha=.70) +
annotate("rect", xmin=2019.5, xmax=2021.5, ymin=-Inf, ymax=Inf,
fill="#FFE8B0", alpha=.35) +
geom_area(fill="#99C4F0", alpha=.22) +
geom_line(linewidth=1.6, colour="#2F5597") +
geom_point(size=3.6, colour="white", stroke=1.4) +
geom_point(size=3.0, colour="#2F5597") +
geom_col(aes(y = yoy * scale_fac), fill="#6BAED6", alpha=.55, width=.55, na.rm=TRUE) +
geom_text_repel(data=end_labels, aes(label=label),nudge_y=rng*0.06, direction="y",seed=42, size=3.8, family="Times New Roman", colour="#2F5597", box.padding=.3, point.padding=.2, min.segment.length=0) +
geom_label_repel(data=p_min, aes(label=paste0("Min: ", lab_num_nty(tong_ts))),
nudge_y=-rng*0.10, nudge_x=0.2, size=3.5, family="Times New Roman",
fill="white", colour="#B03448", box.padding=.5, point.padding=.3, label.size=.3) +
geom_label_repel(data=p_max, aes(label=paste0("Max: ", lab_num_nty(tong_ts))),
nudge_y=rng*0.10, nudge_x=-0.2, size=3.5, family="Times New Roman",
fill="white", colour="#1F3A66", box.padding=.5, point.padding=.3, label.size=.3) +
annotate("segment",x=yr_first+.2,xend=yr_last-.2,y=total$tong_ts[match(yr_first,total$year)]*1.05,yend=total$tong_ts[match(yr_last,total$year)]*1.05,
type="closed", colour="#2F5597", linewidth=1.1, alpha=.7) +
annotate("text",x=mean(c(yr_first, cut_year)), y=max(total$tong_ts)*1.07,
label=paste0("CAGR ", yr_first,"–",cut_year,": ", lab_pct(cagr1)),
family="Times New Roman", fontface="bold", colour="#2F5597", size=4) +
annotate("text",x=mean(c(cut_year+1, yr_last)), y=max(total$tong_ts)*1.07,
label=paste0("CAGR ", cut_year+1,"–",yr_last,": ", lab_pct(cagr2)),
family="Times New Roman", fontface="bold", colour="#2F5597", size=4) +
scale_x_continuous(breaks = total$year,expand = expansion(mult = c(.02, .10))) +
scale_y_continuous(name = "Nghìn tỷ đồng", labels = lab_num_nty,expand = expansion(mult = c(.02, 0.18)),sec.axis = sec_axis(~ . / scale_fac,name = "YoY (%)", labels = lab_pct)) +
coord_cartesian(clip = "off") +
labs(title = toupper("Tăng trưởng tổng tài sản (CARG + YoY"),x = "Năm", y = NULL,subtitle = NULL) +
theme_minimal(base_family = "Times New Roman") +
theme(plot.title = element_text(size=18, face="bold",margin=margin(b=6), hjust=0.5),plot.title.position = "plot",plot.subtitle = element_text(size=11, colour="grey35",margin=margin(b=8)),panel.grid.minor = element_blank(),panel.grid.major.x = element_blank(),panel.grid.major.y = element_line(linetype="dotted", colour="grey80"),axis.title.y.right = element_text(color="#6BAED6", face="bold"),axis.text.x = element_text(size=10),plot.margin = margin(18, 26, 10, 12))
Câu lệnh: (8–11) Tạo bảng total; (17) Hàm tính CAGR; (18) CAGR1 cho giai đoạn đầu (năm 1→5); (19) CAGR2 cho giai đoạn sau (năm 6→cuối); (20) Hệ số chuẩn hoá để đưa YoY lên chung trục; (21–22) Lấy điểm Min và Max tổng TS; (27) Khởi tạo ggplot (năm ~ tổng TS); (34) Cột YoY đã nhân hệ số chuẩn hoá; (44) Không cắt phần tràn ngoài panel; (45) Tiêu đề/nhãn trục; (46–65) Theme: font Times, tiêu đề đậm căn giữa, ẩn lưới phụ, lưới chính chấm, màu trục phụ, canh lề biểu đồ.
Nhận xét:
Năm 2014 là mốc thấp nhất trong chuỗi (ô nhãn đỏ “Min”), còn 2023 là cao nhất (ô nhãn xanh “Max”). Khoảng cách từ đáy 2014 đến đỉnh 2023 rất lớn, cho thấy quy mô tổng tài sản đã mở rộng đáng kể trong 10 năm, tạo nền cho xu thế tăng bền vững.
Pha 2014–2018 Tăng mạnh và ổn định, CAGR ~17,6%/năm. Đường xu hướng đi lên mượt, YoY cao và đều, phản ánh giai đoạn mở rộng quy mô nhanh, tăng trưởng bền vững.
Pha 2019–2023 Duy trì đà tăng (CAGR ~14,6%) nhưng biến động ngắn hạn rõ hơn, đặc biệt giai đoạn 2020–2021 do tác động thị trường và chính sách. Tuy YoY dao động, tổng tài sản vẫn tăng đều nhờ nền tích lũy tốt. vững, chấp nhận biên độ ngắn hạn nhưng không làm gãy xu thế dài hạn.
2.4.1.6 Cấu phần tài sản theo giá trị tuyệt đối
ggplot(long, aes(year, gia_tri / 1e12, fill = khoan_muc)) +
geom_area(color = "white", linewidth = .2, alpha = .95) +
scale_y_continuous(name = "Nghìn tỷ đồng",labels = scales::label_number(big.mark = ".", decimal.mark = ",")) +
scale_fill_manual(values = pal10, name = "Khoản mục") +
labs(title = "CẤU PHẦN TÀI SẢN",x = "Năm",y = "Giá trị (Nghìn tỷ đồng)") +
theme_vn +
theme(plot.title = element_text(hjust = 0, face = "bold", size=10 ),plot.title.position = "plot")
Câu lệnh: (1) Tạo biểu đồ area; (2) Vẽ vùng diện tích; viền trắng mảnh, độ trong suốt cao; (4) Gán bảng màu thủ công pal10; tên legend “Khoản mục”; (5) Đặt tiêu đề, nhãn trục x/y rõ ràng; (6) Áp theme Việt hoá theme_vn; (7) Căn giữa và in đậm tiêu đề; đặt tiêu đề trong vùng đồ thị.
Nhận xét:
Mảng Tiền gửi Khách hàng chiếm phần lớn diện tích và tăng đều qua thời gian, chứng tỏ tổng tài sản phình to chủ yếu nhờ mở rộng huy động. Đây là lớp nền quyết định hình dáng “ngọn núi” của toàn biểu đồ.
Lớp Tiền gửi NHNN dày lên rõ rệt từ 2022–2023, tạo “bậc thềm” mới ở phía trên nền tiền gửi KH. Điều này phản ánh ưu tiên an toàn/thanh khoản trong giai đoạn gần đây (dự trữ, điều tiết). . CK đầu tư tăng lên thấy rõ (đặc biệt 2023) song vẫn chỉ là lớp mỏng trên tổng thể, cho thấy vai trò bổ sung. CK kinh doanh còn nhỏ hơn, đóng góp thứ yếu.
Tài sản hữu hình, vô hình, góp vốn dài hạn và Tài sản khác tạo các dải hẹp, biến động nhẹ—hàm ý duy trì ổn định, không phải động lực chính của tăng trưởng tổng tài sản.
2.4.1.7 Thay đổi tỷ trọng: năm cuối trừ năm đầu
yr_first <- min(long$year, na.rm=TRUE)
yr_last <- max(long$year, na.rm=TRUE)
df <- long %>% filter(year %in% c(yr_first, yr_last)) %>% select(year, khoan_muc, ty_trong) %>% pivot_wider(names_from = year, values_from = ty_trong) %>%mutate(delta= .[[as.character(yr_last)]] - .[[as.character(yr_first)]],
abs_delta = abs(delta),dir = ifelse(delta >= 0, "Tăng", "Giảm"),
label = percent(delta, accuracy=.1, big.mark=".", decimal.mark=","),
khoan_muc = str_to_title(khoan_muc)) %>%arrange(delta)
rng <- max(df$abs_delta, na.rm=TRUE)
pad <- 0.02 * rng
inside_cut <- 0.035
col_pos <- "#1F3A66"
col_neg <- "#B23A48"
col_gold<- "#C89B3C"
df <- df %>%mutate(rk_pos = ifelse(dir=="Tăng", rank(-delta, ties.method="first"), NA),rk_neg = ifelse(dir=="Giảm", rank( delta, ties.method="first"), NA),is_top = (!is.na(rk_pos) & rk_pos<=3) | (!is.na(rk_neg) & rk_neg<=3))
df <- df %>%mutate(inside = abs_delta >= inside_cut,x_lab = ifelse(inside,
ifelse(dir=="Tăng", delta - pad, delta + pad),
ifelse(dir=="Tăng", delta + 0.008, delta - 0.008)),
hjust = ifelse(inside, ifelse(dir=="Tăng", 1, 0),ifelse(dir=="Tăng", 0, 1)),col_txt= ifelse(inside, "white", "gray10"),
col_bar= ifelse(is_top, col_gold, ifelse(dir=="Tăng", col_pos, col_neg)))
refs <- c(-0.05,-0.03,-0.01,0,0.01,0.03,0.05)
ggplot(df, aes(y=reorder(khoan_muc, delta), x=delta)) + geom_vline(xintercept=refs,colour=c(alpha("#9aa3ad",.18),alpha("#9aa3ad",.14),alpha("#9aa3ad",.10), alpha("#6b7076",.28),alpha("#9aa3ad",.10),alpha("#9aa3ad",.14),alpha("#9aa3ad",.18)), linetype=c("solid","dashed","dotted","solid","dotted","dashed","solid"),linewidth=c(.35,.3,.25,.55,.25,.3,.35)) +
geom_segment(aes(x=0, xend=delta, yend=reorder(khoan_muc, delta)),linewidth=6.5, colour=alpha("#d7dbe0",.55), lineend="round") +
geom_segment(aes(x=0, xend=delta, yend=reorder(khoan_muc, delta),colour=col_bar),linewidth=4.5, lineend="round", show.legend=FALSE) +
geom_point(aes(x=delta), size=6.2, colour="white") +
geom_point(aes(x=delta, colour=col_bar), size=4.8, show.legend=FALSE) +
geom_segment(data=subset(df, !inside), aes(x=delta, xend=x_lab, y=reorder(khoan_muc, delta),yend=reorder(khoan_muc, delta)), colour="grey60", linewidth=.35, lineend="round") +
geom_text(aes(x=x_lab, label=label, hjust=hjust, colour=I(col_txt)), family="Times New Roman", fontface="bold", size=3.8, lineheight=.95,show.legend=FALSE) +
scale_colour_identity() +
scale_x_continuous(labels=lab_pct,limits=c(-rng*1.18, rng*1.18),breaks=pretty(c(-rng, rng), n=5),expand=expansion(mult=c(.02,.10))) +
labs(title = toupper(paste0("Thay đổi tỷ trọng: ",yr_last, " trừ ", yr_first)),x = "Δ Tỷ trọng", y = NULL) +
theme_minimal(base_family="Times New Roman") +
theme(plot.background = element_rect(fill="white", colour=NA),
plot.title = element_text(size=10, face="bold",margin=margin(b=6)),
plot.subtitle = element_text(size=11, colour="grey30",margin=margin(b=10)),
axis.text.y = element_text(size=12, colour="grey10"),
axis.text.x = element_text(size=11, colour="grey25"),
axis.title.x = element_text(size=11),
panel.grid = element_blank(),
plot.margin = margin(10, 48, 10, 10))
Câu lệnh: (1–2) Lấy năm đầu/cuối; (3–6) Tạo bảng rộng: tỷ trọng năm cuối – năm đầu → delta;(7–9) Tính biên độ & khoảng đệm cho trục; (17) Khởi tạo plot; (19) Vẽ đoạn từ 0→delta (nền mờ); (22) Chấm tại delta (màu theo dấu); (25) Giữ nguyên màu theo thang đã đặt; (26) Trục X dạng %, đối xứng quanh 0, thêm đệm; (27) Tiêu đề/nhãn trục.
Nhận xét:
Tiền gửi NHNN (+7,3 điểm %) và Tiền gửi khách hàng (+2,7 điểm %) là hai động lực chính, thể hiện xu hướng tăng tài sản thanh khoản và mở rộng huy động bền vững.
CK kinh doanh (+1,3 điểm %) tăng nhẹ, cho thấy mở rộng tham gia thị trường tài chính nhưng vẫn ở quy mô nhỏ.
Cho vay TCTD khác (−5,4 điểm %) giảm mạnh nhất, cùng với CK đầu tư (−2,6 điểm %) và Tài sản khác (−2,4 điểm %) thu hẹp, phản ánh tái cơ cấu sang tài sản an toàn hơn.
Các khoản vô hình, hữu hình, góp vốn dài hạn gần như đi ngang, cho thấy không phải trọng tâm tăng trưởng.
2.4.1.8 CAGR 2014–2023 theo khoản mục
lab_pct <- label_percent(accuracy = .1, big.mark = ".", decimal.mark = ",")
lab_num <- label_number(big.mark = ".", decimal.mark = ",")
asset_cols <- c("tien_gui_khach_hang","tien_gui_nhnn","tien_vang_ngoai_te","chung_khoan_kinh_doanh",
"chung_khoan_dau_tu","gop_von_dai_han","cho_vay_cac_tctd_khac","ts_huu_hinh","ts_vo_hinh","tai_san_khac")
yr_first <- min(shb1$year); yr_last <- max(shb1$year)
long <- shb1 |>select(year, tong_tai_san, all_of(asset_cols))|>pivot_longer(all_of(asset_cols), names_to="khoan_muc", values_to="gia_tri")|>
group_by(year) |> mutate(ty_trong = gia_tri/sum(gia_tri)) |> ungroup() |>
mutate(khoan_muc = recode(khoan_muc,"tien_gui_khach_hang"="Tiền gửi khách hàng","tien_gui_nhnn" ="Tiền gửi NHNN","tien_vang_ngoai_te" ="Tiền, vàng, ngoại tệ","chung_khoan_kinh_doanh"="CK kinh doanh","chung_khoan_dau_tu" ="CK đầu tư","gop_von_dai_han" ="Góp vốn dài hạn","cho_vay_cac_tctd_khac"="Cho vay TCTD khác","ts_huu_hinh" ="Tài sản hữu hình","ts_vo_hinh"="Tài sản vô hình","tai_san_khac" ="Tài sản khác"))
cagr_tbl <- long |>group_by(khoan_muc) |>summarise(share_last = ty_trong[year==yr_last] %>% na.omit() %>% {.[1]},v0 = gia_tri[year==yr_first] %>% na.omit() %>% {.[1]},vT = gia_tri[year==yr_last] %>% na.omit() %>% {.[1]},.groups = "drop") |>
mutate(n = yr_last-yr_first,CAGR = ifelse(v0>0 & vT>0, (vT/v0)^(1/n)-1, NA_real_),size_last = vT)
med_share <- median(cagr_tbl$share_last, na.rm=TRUE)
med_cagr <- median(cagr_tbl$CAGR, na.rm=TRUE)
quad_df <- cagr_tbl |>mutate(grp_share = if_else(share_last > med_share, "Tỷ trọng cao", "Tỷ trọng thấp"),
grp_cagr = if_else(CAGR > med_cagr, "CAGR cao", "CAGR thấp"),
quadrant = factor(paste(grp_cagr, "—", grp_share),levels = c("CAGR cao — Tỷ trọng cao","CAGR cao — Tỷ trọng thấp","CAGR thấp — Tỷ trọng cao","CAGR thấp — Tỷ trọng thấp")))
p <- ggplot(quad_df, aes(share_last, CAGR, size = size_last)) +
geom_point(alpha=.9, colour="#1F3A66", fill="#9DC3E6", shape=21,stroke=.6) +
geom_label_repel(data = subset(quad_df, khoan_muc != "Tiền gửi khách hàng"),
aes(label = khoan_muc),size=3.2, family="Times New Roman",box.padding=.55, point.padding=.35,label.size=.2,label.r=unit(0.15,"lines"),min.segment.length=0, segment.size=.3, segment.alpha=.7,force=2.2, force_pull=1, max.overlaps=Inf, seed=123) +
geom_label_repel(data = subset(quad_df, khoan_muc == "Tiền gửi khách hàng"),aes(label = khoan_muc),size=3.2, family="Times New Roman",direction="y", nudge_y=.03, box.padding=.45, point.padding=.35,label.size=.2, label.r=unit(0.15,"lines"),min.segment.length=0, segment.size=.3, segment.alpha=.7,force=3, force_pull=1, max.overlaps=Inf, seed=123) +
facet_wrap(~ quadrant, ncol = 2, scales = "free",
labeller = ggplot2::labeller(quadrant = ggplot2::label_wrap_gen(width = 18))) +
scale_x_continuous(labels = lab_pct, expand = expansion(mult=c(.05,.10))) +
scale_y_continuous(labels = lab_pct, expand = expansion(mult=c(.06,.14))) +
scale_size_continuous(range = c(2, 9), labels = lab_num,guide = guide_legend(
title = "Giá trị (năm cuối)", nrow = 1, byrow = TRUE,
override.aes = list(fill="#9DC3E6", colour="#1F3A66", alpha=.9, stroke=.6))) +
labs(title = toupper("TỶ TRỌNG – TĂNG TRƯỞNG (CAGR) THEO KHOẢN MỤC"),
subtitle = "Chia 4 ô theo median của CAGR và tỷ trọng",
x = "Tỷ trọng trong tổng tài sản (năm cuối)", y = "CAGR (2014–2023)") +
theme_minimal(base_family="Times New Roman") +
theme(strip.text = element_text(size=10, face="bold",margin=margin(3,6,3,6)),
strip.background = element_rect(fill="#F2F2F2", color=NA),
panel.grid.minor = element_blank(),
panel.grid.major.y = element_line(linetype="dotted", color="gray80", linewidth=.25),
legend.position = "bottom",
legend.direction = "horizontal",
legend.key.width = unit(12,"pt"),
legend.key.height = unit(12,"pt"),
plot.margin = margin(8,8,8,8)) +
theme(plot.title = element_text(face = "bold", hjust = 0.5),
plot.subtitle=element_text(hjust=0.5))
p
Câu lệnh: (3) Chọn các cột tài sản để tính; (4) Lấy năm đầu/cuối; (10–11) Tính CAGR cho từng khoản mục; (12) Tính median của tỷ trọng và CAGR; (13–15) Tạo nhóm: “Tỷ trọng cao/thấp” và “CAGR cao/thấp”, ghép thành 4 phần tư; (16) Khởi tạo biểu đồ bubble plot; (17) Vẽ điểm bong bóng; (20) Tách 4 ô (facet) theo nhóm phần tư.
Nhận xét: Nhóm CAGR cao – tỷ trọng cao gồm chứng khoán kinh doanh và tiền gửi NHNN, phản ánh chiến lược mở rộng đầu tư tài chính ngắn hạn và tăng dự trữ thanh khoản. Tiền gửi khách hàng có tỷ trọng lớn nhất nhưng tăng chậm, cho thấy nền huy động ổn định, ít biến động. Ngược lại, cho vay TCTD khác nằm ở nhóm CAGR thấp – tỷ trọng thấp, thể hiện xu hướng thu hẹp liên ngân hàng. Các khoản như tài sản hữu hình, vô hình, tiền–ngoại tệ, góp vốn dài hạn có tỷ trọng nhỏ nhưng tăng dương, góp phần đa dạng hóa danh mục và nâng cao an toàn vốn.
2.4.1.9 Phân bố tăng trưởng YoY Tổng tài sản theo giai đoạn
lab_pct <- label_percent(accuracy = .1, decimal.mark = ",", big.mark = ".")
has_yoy <- "g_Tong_TS" %in% names(shb1)
has_phase <- "giai_doan" %in% names(shb1)
df_yoy <- shb1 %>%arrange(year) %>%mutate(yoy= if (has_yoy) g_Tong_TS/100 else
(tong_tai_san/dplyr::lag(tong_tai_san) - 1),
giai_doan = if (has_phase) as.character(giai_doan)
else if_else(year <= 2018, "2014–2018", "2019–2023")) %>%filter(!is.na(yoy)) %>%mutate(giai_doan = fct_rev(factor(giai_doan)))
mean_by_phase <- df_yoy %>% group_by(giai_doan) %>%
summarise(mu = mean(yoy, na.rm = TRUE), .groups = "drop")
ggplot(df_yoy, aes(x = yoy, y = giai_doan)) +
ggridges::geom_density_ridges_gradient(aes(fill = after_stat(x)),scale = 0.9,rel_min_height = 0.01,size = .3, color = "white", alpha = .95) +
geom_vline(xintercept = 0, color = "grey75", linewidth = .6) +
geom_point(data = mean_by_phase,aes(x = mu, y = giai_doan), shape = 23, size = 3.2,fill = "white", color = "#1F3A66", stroke = .7) +
scale_fill_gradient2(low = "#EF4444", mid = "#ECECEC", high = "#16A34A",midpoint = 0, guide = "none") +
scale_x_continuous(labels = lab_pct,expand = expansion(mult = c(.02, .12))) +
coord_cartesian(clip = "off") +
labs(title = "PHÂN BỐ TĂNG TRƯỞNG YoY CỦA TỔNG TÀI SẢN THEO GIAI ĐOẠN", x = "Tăng trưởng năm sau so năm trước (YoY, %)", y = NULL) +
theme_minimal(base_family = "Times New Roman") +
theme(panel.grid.minor = element_blank(),
axis.text.y = element_text(size = 11),
plot.title = element_text(face = "bold", hjust=0.5, size=10),
panel.spacing.y = unit(12, "pt"),
plot.margin = margin(6, 28, 6, 6)) 
Câu lệnh: (4) Tính YoY (tăng trưởng tổng tài sản năm sau so với năm trước); (5) Chia giai đoạn: 2014–2018 và 2019–2023; (8) Tính trung bình YoY theo giai đoạn; (9) Tạo biểu đồ ridgeline với trục X = YoY, Y = giai đoạn; (10) Dải mật độ màu trắng, trong suốt nhẹ; (11) Kẻ đường dọc x=0 (mốc 0%); (12) Thêm điểm trung bình từng giai đoạn.
Nhận xét: YoY theo giai đoạn cho thấy 2014–2018 có mức trung bình cao và ổn định hơn, nhưng phân tán lớn, hai đỉnh, phản ánh các năm tăng mạnh đan xen tăng vừa; phân phối lệch phải với đuôi dài cho thấy xác suất xuất hiện năm tăng đột biến. Giai đoạn 2019–2023 tập trung quanh một mức dương vừa phải, biến động hẹp hơn, ổn định hơn nhưng ít bứt phá; cả hai pha hầu như không có YoY âm, rủi ro suy giảm thấp.
2.4.2 Mối quan hệ giữa các nhóm tài sản
2.4.2.1 Mối quan hệ tổng tài sản và chứng khoán đầu tư (chuẩn hoá)
fmt_nty <- scales::label_number(big.mark=".", decimal.mark=",")
plot2 <- shb1 %>%mutate(tong_ts_nty = tong_tai_san/1e12,ckdt_nty = chung_khoan_dau_tu/1e12) %>%
mutate(ckdt_norm = (ckdt_nty - min(ckdt_nty, na.rm=TRUE)) /
(max(ckdt_nty, na.rm=TRUE) - min(ckdt_nty, na.rm=TRUE)) *
(max(tong_ts_nty, na.rm=TRUE) - min(tong_ts_nty, na.rm=TRUE)) +
min(tong_ts_nty, na.rm=TRUE)) %>%
tidyr::drop_na(tong_ts_nty, ckdt_norm)
last2 <- plot2[which.max(plot2$year), , drop = FALSE]
last2lbl <- paste0("CKĐT = ", fmt_nty(last2$ckdt_nty))
Ymax <- max(plot2$tong_ts_nty, na.rm=TRUE)
Cmin <- min(plot2$ckdt_nty, na.rm=TRUE)
Crng <- max(plot2$ckdt_nty, na.rm=TRUE) - Cmin
ggplot(plot2, aes(x = factor(year))) +
geom_col(aes(y = tong_ts_nty, fill = "Tổng tài sản"), alpha = .75) +
geom_line(aes(y = ckdt_norm, colour = "CK đầu tư"), linewidth = 1.1, group = 1) +
geom_point(aes(y = ckdt_norm, colour = "CK đầu tư"), size = 2) +
geom_text(data = last2, aes(y = ckdt_norm, label = last2lbl),
vjust = -0.6, colour = "#0ea5e9", size = 3) +
geom_vline(xintercept = as.numeric(factor(max(plot2$year))),
linetype = "dotted", colour = "grey60") +
scale_y_continuous(name = "Nghìn tỷ đồng",labels = fmt_nty,sec.axis = sec_axis(~ (. / Ymax) * Crng + Cmin, name = "CK đầu tư (nghìn tỷ)", labels = fmt_nty)) +
scale_fill_manual(values = c("Tổng tài sản" = "#4f46e5")) +
scale_color_manual(values = c("CK đầu tư" = "#0ea5e9")) +
labs(title = "MỐI QUAN HỆ TỔNG TÀI SẢN VÀ CHỨNG KHOÁN ĐẦU TƯ",
x = "Năm", y = NULL, colour = NULL, fill = NULL) +
theme_minimal(base_family = "Times New Roman") +
theme(plot.title = element_text(face = "bold", hjust = 0.5),
legend.position = "bottom",panel.grid.minor = element_blank())
Câu lệnh: (2) Tạo bảng gồm tổng tài sản và chứng khoán đầu tư; (3) Chuẩn hoá CKĐT để so sánh theo tỷ lệ 0–1 (min–max); (5) Xác định giới hạn min–max cho hai biến; (6) Vẽ cột tổng tài sản và đường CKĐT trên cùng trục năm; (9) Trục trái: tổng tài sản (nghìn tỷ); trục phải: CKĐT (nghìn tỷ); (10) Đặt màu xanh dương cho tổng tài sản và xanh nhạt cho CKĐT; (11) Đặt tiêu đề, nhãn trục,định dạng.
Nhận xét
Biểu đồ cho thấy tổng tài sản tăng đều, trong khi CK đầu tư (CKĐT) dao động mạnh hơn – cùng xu hướng dài hạn nhưng không đồng pha ngắn hạn.
CKĐT tăng vọt năm 2018 rồi giảm sâu, phản ánh giai đoạn đẩy mạnh đầu tư tài chính ngắn hạn khi thị trường thuận lợi, sau đó cơ cấu lại danh mục. Giai đoạn 2021–2023 CKĐT phục hồi, song vẫn dưới đỉnh cũ, còn tổng tài sản tiếp tục tăng nhờ kênh huy động và dự trữ NHNN.
Tỷ trọng CKĐT trong tổng tài sản nhỏ, cho thấy ngân hàng ưu tiên tài sản sinh lãi ổn định và chỉ phân bổ linh hoạt vào đầu tư tài chính.
2.4.2.2 Tăng trưởng YoY của chứng khoán đầu tư và góp vốn dài hạn
pick <- c("g_GopVon","g_CK")
label_map <- c(g_CK = "CK đầu tư",g_GopVon = "Góp vốn dài hạn")
long_g <- shb1 %>%dplyr::select(year, all_of(pick)) %>%
tidyr::pivot_longer(-year, names_to = "bien", values_to = "yoy") %>%
mutate(bien = factor(bien, levels = pick, labels = unname(label_map[pick])))
ggplot(long_g, aes(year, yoy, colour = bien)) +
geom_hline(yintercept = 0, colour = "#9ca3af") +
geom_line(linewidth = 1.15, alpha = .95) +
geom_point(size = 2.6, stroke = .2) +
geom_smooth(se = FALSE, linetype = "dotted", linewidth = .9, alpha = .9) +
facet_wrap(~ bien, scales = "free_y", ncol = 2) +
scale_y_continuous(labels = scales::label_number(accuracy = .1, suffix = "%", big.mark = ".", decimal.mark = ","),expand = expansion(mult = c(.02, .08)) ) +
scale_color_manual(values = c("#0EA5E9", "#EF4444")) +
labs(title = "ĐỘNG THÁI TĂNG TRƯỞNG YoY CỦA KHOẢN MỤC SAU",subtitle = "Đường chấm là xu hướng (LOESS).
Trục 0% kẻ ngang để so sánh tăng/giảm.",
x = "Năm", y = "%") +
theme_minimal(base_family = "Times New Roman") +
theme(legend.position = "none", plot.title = element_text(face = "bold", size = 10, colour = "#111827",hjust=0.5),plot.subtitle = element_text(colour = "#374151", hjust=0.5),strip.text = element_text(face = "bold", size = 12),panel.spacing = unit(1.1, "lines"),axis.title.y = element_text(margin = margin(r = 8)))
Câu lệnh: (1) Chọn 2 biến tăng trưởng YoY (2) Chuyển dữ liệu sang dạng dài (pivot): cột “biến” và giá trị “yoy”; gán nhãn theo map; (5) Thêm đường xu hướng LOESS dạng chấm (dotted); (8) Đặt màu thủ công: xanh cho CK đầu tư, đỏ cho Góp vốn.
Nhận xét: Biểu đồ cho thấy hai khoản mục có xu hướng biến động hoàn toàn khác biệt. Góp vốn dài hạn gần như đi ngang trong nhiều năm, trước khi bứt phá mạnh vào 2023 với mức tăng trên 800%, phản ánh giai đoạn ngân hàng đẩy mạnh đầu tư vào công ty con hoặc dự án chiến lược. Trong khi đó, Chứng khoán đầu tư dao động mạnh theo chu kỳ, với đỉnh 2018 trên 100%, sau đó liên tục lên xuống thất thường quanh mức trung bình, cho thấy đặc trưng nhạy cảm với biến động thị trường tài chính và chiến lược điều chỉnh danh mục đầu tư linh hoạt hơn.
2.4.2.3 So sánh biến động của chứng khoán đầu tư và tiền gửi NHNN
scale01 <- function(x) (x - min(x, na.rm = TRUE)) / (max(x, na.rm = TRUE) - min(x, na.rm = TRUE))
df_norm <- shb1 %>%transmute(year,`CK đầu tư` = scale01(chung_khoan_dau_tu),`Tiền gửi NHNN` = scale01(tien_gui_nhnn)) %>%
pivot_longer(-year, names_to = "series", values_to = "norm") %>%
arrange(series, year)
last_pts <- df_norm %>% group_by(series) %>% slice_max(year, n = 1, with_ties = FALSE) %>% ungroup()
ggplot(df_norm, aes(x = year, y = norm, color = series)) +
annotate("rect", xmin = 2021 - 0.5, xmax = max(df_norm$year) + 0.5, ymin = -Inf, ymax = Inf, alpha = .06, fill = "#6B7280") +
geom_line(linewidth = 1.05) +
geom_point(size = 2) +
ggrepel::geom_label_repel(data = last_pts,aes(label = paste0(series, " — ", label_percent(accuracy = 1)(norm))),fill = "white", label.size = .2, size = 3.3, family = "Times New Roman",box.padding = .25, point.padding = .15, direction = "y",min.segment.length = 0, segment.size = .3, segment.alpha = .6,nudge_x = .35, seed = 123, show.legend = FALSE) +
scale_color_manual(values = c("CK đầu tư" = "#4F9DE6","Tiền gửi NHNN" = "#EF6C64")) +
scale_y_continuous(labels = label_percent(accuracy = 1, decimal.mark = ","),limits = c(0, 1), expand = expansion(mult = c(.02, .04))) +
scale_x_continuous(breaks = pretty(shb1$year), expand = expansion(mult = c(.02, .10))) +
labs(title = "BIẾN ĐỘNG CHỨNG KHOÁN ĐẦU TƯ VÀ TIỀN GỬI NHNN",
x = "Năm", y = "Chuẩn hoá 0–1", color = NULL) +
theme_minimal(base_family = "Times New Roman") +
theme(panel.grid.minor = element_blank(),legend.position = "none", plot.title = element_text(face = "bold", hjust=0.5, size=10),plot.margin = margin(6, 18, 6, 6))
Câu lệnh: (1) Chuẩn hóa dữ liệu để đưa CK đầu tư và Tiền gửi NHNN về cùng thang 0–1; (2) Gom dữ liệu dài, gồm cột “series” (loại biến) và “norm” (giá trị chuẩn hóa); (3) Lấy điểm năm cuối cho từng biến để gắn nhãn; (4) Vẽ đường thời gian thể hiện xu hướng hai biến; (5) Thêm nhãn ở năm cuối, hiển thị tên biến và % giá trị chuẩn hóa.
Nhận xét: Giai đoạn 2014–2018, cả hai chỉ tiêu cùng tăng, CK đầu tư biến động mạnh và đạt đỉnh 2018, thể hiện giai đoạn mở rộng đầu tư. 2019–2021, CK đầu tư giảm rồi ổn định, trong khi Tiền gửi NHNN tăng đều, phản ánh dịch chuyển sang tài sản thanh khoản cao. Đến 2023, Tiền gửi NHNN đạt đỉnh 100%, còn CK đầu tư chỉ bằng 54% mức cũ – cho thấy ngân hàng ưu tiên an toàn vốn hơn là đầu tư rủi ro.
2.4.2.4 Cơ cấu tài sản theo biểu đồ Pareto
fmt_dong <- label_number(big.mark = ".", decimal.mark = ",", accuracy = 1)
asset_map <- c(
tien_gui_khach_hang = "Tiền gửi KH",
tien_gui_nhnn = "Tiền gửi NHNN",
tien_vang_ngoai_te = "Tiền, Vàng, Ngoại tệ",
chung_khoan_kinh_doanh = "CK Kinh doanh",
chung_khoan_dau_tu = "CK Đầu tư",
gop_von_dai_han = "Góp vốn dài hạn",
cho_vay_cac_tctd_khac = "Cho vay TCTD khác",
ts_huu_hinh = "Tài sản hữu hình",
ts_vo_hinh = "Tài sản vô hình",
tai_san_khac = "Tài sản khác")
stopifnot(all(c("year", names(asset_map)) %in% names(shb1)))
nam_cuoi <- max(shb1$year, na.rm = TRUE)
df_pareto <- shb1 %>%
filter(year == nam_cuoi) %>%
tidyr::pivot_longer(names(asset_map), names_to = "key", values_to = "gia_tri") %>%mutate(khoan_muc = unname(asset_map[key])) %>%select(khoan_muc, gia_tri) %>%arrange(desc(gia_tri)) %>%
mutate(tl_luy_ke = cumsum(gia_tri) / sum(gia_tri, na.rm = TRUE), tl_luy_ke_quy_doi = tl_luy_ke * max(gia_tri, na.rm = TRUE))
highlight_items <- c("Tổng tài sản", "Tiền gửi KH", "Tiền gửi Khách hàng")
ggplot(df_pareto, aes(x = reorder(khoan_muc, gia_tri), y = gia_tri)) +
geom_col(fill = "#445FE5", width = .85, alpha = .95) +
geom_text(aes(label = fmt_dong(gia_tri),hjust = if_else(khoan_muc %in% highlight_items, 1.1, -0.05),color = if_else(khoan_muc %in% highlight_items, "white", "#0F1B2E")),size = 3.6, family = "Times New Roman") +
scale_color_identity() +
geom_line(aes(y = tl_luy_ke_quy_doi, group = 1),color = "#EF4444", linewidth = 1.1) +
geom_point(aes(y = tl_luy_ke_quy_doi), color = "#EF4444", size = 2.4) +
geom_hline(yintercept = 0.8 * max(df_pareto$gia_tri, na.rm = TRUE),linetype = "dashed", color = "grey60") +
annotate("label",x = 1,y = 0.8 * max(df_pareto$gia_tri, na.rm = TRUE),label = "Mốc 80%", size = 3.5,family = "Times New Roman", fill = "white", color = "grey25") +
coord_flip(clip = "off") +
scale_y_continuous(labels = fmt_dong, expand = expansion(mult = c(0, .08))) +
labs(title = paste0("BIỂU ĐỒ CƠ CẤU TÀI SẢN THEO PARETO (", nam_cuoi, ")"),subtitle = "Cột: giá trị từng khoản mục · Đường: tỉ lệ lũy kế (%)",x = NULL, y = "Đồng") +
theme_minimal(base_family = "Times New Roman") +
theme(plot.title = element_text(face = "bold", size = 15, hjust=0.5),
plot.subtitle = element_text(size = 12, color = "#374151", hjust=0.5),
axis.text.y = element_text(size = 12),
panel.grid.minor = element_blank(),
plot.margin = margin(8, 20, 8, 8))
Câu lệnh: (2) Khai báo map tên biến tài sản → nhãn đẹp; (5) Lọc năm cuối, pivot sang dạng dài: khoản_mục–giá_trị; đổi tên theo map, sắp xếp giảm dần; (6) Tính tỉ lệ lũy kế (Pareto) và bản sao 0–1 để vẽ đường; (8) Vẽ cột giá trị theo khoản mục; (11) Kẻ đường mốc 80% và chú thích “Mốc 80%”; (12) Lật trục (hàng ngang), định dạng trục %, nới biên.
Nhận xét:
Kết quả cho thấy “Tiền gửi khách hàng” chiếm tỷ trọng áp đảo, là nguồn vốn cốt lõi và ổn định, giữ vai trò trung tâm trong thanh khoản và tăng trưởng tín dụng. Các khoản như “Tiền gửi NHNN”, “Tài sản khác” và “CK đầu tư” đóng góp thêm nhưng thấp hơn nhiều; cộng lại bốn nhóm này đã vượt 80% tổng tài sản – thể hiện cơ cấu tập trung cao.
Các khoản còn lại (Góp vốn dài hạn, Tài sản hữu hình, Cho vay TCTD khác, Tài sản vô hình) chiếm tỷ trọng nhỏ, phản ánh chiến lược an toàn, ưu tiên tài sản thanh khoản. Tuy nhiên, sự tập trung quá lớn cũng làm giảm tính đa dạng hóa danh mục
2.4.2.5 Mối quan hệ quy mô tổng tài sản và tỷ trọng chứng khoán đầu tư
fmt_num <- label_number(big.mark=".", decimal.mark=",")
fmt_pct <- label_percent(accuracy = 0.1, big.mark=".", decimal.mark=",")
mu_x <- mean(shb1$tong_tai_san, na.rm = TRUE)
mu_y <- mean(shb1$pct_CK_dau_tu, na.rm = TRUE)
ggplot(shb1, aes(tong_tai_san, pct_CK_dau_tu)) +
annotate("rect", xmin=-Inf, xmax=mu_x, ymin=-Inf, ymax=mu_y,
fill="#E5E7EB", alpha=.25) +
annotate("rect", xmin=mu_x, xmax= Inf, ymin=-Inf, ymax=mu_y,
fill="#E5E7EB", alpha=.15) +
annotate("rect", xmin=-Inf, xmax=mu_x, ymin=mu_y, ymax= Inf,
fill="#E5E7EB", alpha=.15) +
annotate("rect", xmin=mu_x, xmax= Inf, ymin=mu_y, ymax= Inf,
fill="#E5E7EB", alpha=.05) +
geom_smooth(se = FALSE, method = "loess", span = .7,linewidth = .9, linetype = "longdash", color = "#1F3A66") +
geom_point(size = 3.2, stroke = .2, color = "#2F5597") +
ggrepel::geom_text_repel(aes(label = year),size = 3, family = "Times New Roman",box.padding = .25, point.padding = .15,max.overlaps = Inf, seed = 123, color = "#1F2A44") +
geom_vline(xintercept = mu_x, color = "grey60", linewidth = .5) +
geom_hline(yintercept = mu_y, color = "grey60", linewidth = .5) +
annotate("label", x = mu_x, y = -Inf, vjust = -0.2,label = paste0("TB TS: ", fmt_num(mu_x)),size = 3, fill = "white", label.size = .25) +
annotate("label", x = -Inf, y = mu_y, hjust = -0.05,label = paste0("TB CKĐT: ", fmt_pct(mu_y)), size = 3, fill = "white", label.size = .25) +
scale_x_continuous(labels = fmt_num) +
scale_y_continuous(labels = fmt_pct) +
labs(title = "MỐI QUAN HỆ: QUY MÔ TỔNG TÀI SẢN VS TỶ TRỌNG CKĐT",
subtitle = "Vạch đứt: giá trị trung bình; nền mờ chia 4 ô giúp so sánh nhanh",
x = "Tổng tài sản (triệu đồng)",y = "CKĐT (%)") +
theme_minimal(base_family = "Times New Roman") +
theme(panel.grid.minor = element_blank(),
panel.grid.major = element_line(color = "#E6E6E6"),
plot.title = element_text(face="bold", hjust=0.5),
plot.subtitle = element_text(color="#374151", hjust=0.5),
axis.title.x = element_text(margin = margin(t = 6)),
axis.title.y = element_text(margin = margin(r = 6)))
Câu lệnh: (4–5) Tính trung bình tổng tài sản và tỷ trọng CK đầu tư; (6) Tạo biểu đồ: trục X = Tổng tài sản, Y = Tỷ trọng CKĐT; (7–12) Tô 4 vùng nền chia theo giá trị TB của X và Y (4 ô so sánh nhanh); (13) Vẽ đường loess (xu hướng), nét đứt xám; (14) Vẽ điểm dữ liệu; (16–17) Đường ngang & dọc tại giá trị trung bình (TB); (18–19) Ghi nhãn hai đường TB với giá trị trung bình tương ứng.
Nhận xét: Trong 2015–2018, tỷ trọng CKĐT tăng mạnh, đạt đỉnh năm 2018 (~1.500%) khi quy mô tài sản còn thấp, cho thấy ngân hàng tập trung đầu tư tài chính ngắn hạn để tối ưu lợi nhuận. Sau 2018, tỷ trọng CKĐT giảm nhanh và ổn định, trong khi tổng tài sản tăng mạnh, phản ánh sự dịch chuyển chiến lược sang các tài sản sinh lời ổn định hơn. Từ 2020 trở đi, tổng tài sản vượt mức trung bình, còn tỷ trọng CKĐT duy trì ở mức thấp (600–700%), thể hiện ưu tiên củng cố quy mô, tăng thanh khoản và giảm rủi ro thị trường.
2.4.2.6 Cơ cấu tài sản: thanh khoản và phần còn lại
lab_pct <- scales::label_percent(accuracy=.1, decimal.mark=",", big.mark=".")
liq_long <- shb1 |>
dplyr::arrange(year) |>
dplyr::transmute(year,`Tài sản thanh khoản` = (tien_gui_nhnn + tien_vang_ngoai_te + cho_vay_cac_tctd_khac) / tong_tai_san,`Phần còn lại`= 1 - `Tài sản thanh khoản`) |>
tidyr::pivot_longer(-year, names_to="nhom", values_to="ty_trong")
ggplot(liq_long, aes(year, ty_trong, color=nhom)) +
geom_hline(yintercept=.5, linetype="dotted", color="grey75", linewidth=.4) +
geom_line(linewidth=1) + geom_point(size=2) +
scale_color_manual(values=c("Tài sản thanh khoản"="#1F3A66", "Phần còn lại"="#EF4444")) +
scale_y_continuous(labels=lab_pct, limits=c(0,1), expand=ggplot2::expansion(mult=c(.02,.04))) +
labs(title="CƠ CẤU TÀI SẢN: THANH KHOẢN VS PHẦN CÒN LẠI",
subtitle="Hai đường biểu diễn tỷ trọng theo thời gian",
x="Năm", y="Tỷ trọng trong tổng tài sản", color=NULL) +
theme_minimal(base_family="Times New Roman") +
theme(legend.position="top", panel.grid.minor=element_blank(),
plot.title=element_text(face="bold", hjust=.5), plot.subtitle=element_text(hjust=.5))
Câu lệnh: (2–3) Tạo dữ liệu: tính Tài sản thanh khoản và Phần còn lại theo năm, rồi pivot dài → nhom, ty_trong; (4) Khởi tạo ggplot: x = năm, y = tỷ trọng, màu theo nhom; (5) Vẽ đường mốc y = 50% (nét chấm); (6) Vẽ đường xu hướng và các điểm; (7) Gán màu thủ công cho 2 nhóm.
Nhận xét: Biểu đồ cho thấy cơ cấu tài sản của SHB có sự chênh lệch rõ rệt giữa tài sản thanh khoản và phần còn lại. Trong giai đoạn 2014–2023, phần còn lại (chủ yếu là cho vay, đầu tư, góp vốn…) luôn chiếm trên 90% tổng tài sản, duy trì xu hướng ổn định. Ngược lại, tỷ trọng tài sản thanh khoản duy trì ở mức thấp, chỉ dao động quanh 3–7%, và tăng nhẹ vào năm 2023. Điều này phản ánh chiến lược ưu tiên sử dụng vốn cho hoạt động sinh lời dài hạn hơn là dự trữ thanh khoản ngắn hạn, đồng thời cho thấy ngân hàng vẫn kiểm soát được khả năng thanh toán mà không cần duy trì tỷ trọng tài sản lỏng quá cao.
2.4.3 Phân tích tổng hợp và tương quan
2.4.3.1 Tăng trưởng tổng tài sản: Phân tích Quy mô và động lực
fmt_nty <- function(x) scales::label_number(big.mark=".", decimal.mark=",")(x/1e12)
fmt_pct <- scales::label_percent(accuracy=.1, big.mark=".", decimal.mark=",")
df <- shb1 |> dplyr::arrange(year) |>
dplyr::mutate(g_Tong_TS = tong_tai_san/lag(tong_tai_san) - 1)
s <- max(df$tong_tai_san, na.rm=TRUE) / max(df$g_Tong_TS[is.finite(df$g_Tong_TS)], na.rm=TRUE)
ggplot(df, aes(year)) +
geom_area(aes(y=tong_tai_san, fill="Tổng tài sản"), alpha=.55) +
geom_line(aes(y=g_Tong_TS*s, colour="Tốc độ tăng trưởng (%)"), linewidth=1.1) +
geom_point(aes(y=g_Tong_TS*s, colour="Tốc độ tăng trưởng (%)"), size=2.2) +
scale_y_continuous(labels=fmt_nty, name="Tổng tài sản (Nghìn tỷ đồng)",
sec.axis=sec_axis(~./s, name="Tốc độ tăng trưởng (%)", labels=fmt_pct),
expand=ggplot2::expansion(mult=c(0,.12))) +
scale_x_continuous(breaks=df$year) +
scale_fill_manual(values=c("Tổng tài sản"="#4478A5")) +
scale_color_manual(values=c("Tốc độ tăng trưởng (%)"="#D9534F")) +
labs(title="TỔNG TÀI SẢN & TĂNG TRƯỞNG" , x="Năm", y=NULL, fill=NULL, colour=NULL) +theme_minimal() +theme(panel.grid.minor=element_blank(),plot.title=element_text(face="bold", hjust=.5))
Câu lệnh: (3) Sắp xếp dữ liệu theo năm; (4) Tính YoY của tổng tài sản; (5) Hệ số chuẩn hoá để đặt YoY chung trục; (6) Khởi tạo ggplot theo năm; (7) Vẽ vùng diện tích cho tổng tài sản; (8) Vẽ đường YoY (đã nhân hệ số); (9) Thêm điểm cho YoY.
Nhận xét: Biểu đồ cho thấy tổng tài sản của SHB tăng liên tục trong giai đoạn 2014–2023, từ khoảng 150 nghìn tỷ lên hơn 650 nghìn tỷ đồng, phản ánh quá trình mở rộng quy mô bền vững. Tuy nhiên, tốc độ tăng trưởng biến động mạnh qua các năm, có những giai đoạn tăng vọt như 2017 và 2021 trên 20%, xen kẽ giai đoạn chững lại (2018–2019) và giảm mạnh năm 2022 (~9%). Điều này cho thấy SHB duy trì được xu hướng tăng dài hạn nhưng chịu ảnh hưởng nhất thời từ biến động kinh tế và điều chỉnh chiến lược tăng trưởng, trước khi phục hồi trở lại vào 2023.
2.4.3.2 Tương quan trượt 3 năm: tổng tài sản và chứng khoán đầu tư
lab_pct01 <- function(x) formatC(x, format="f", digits=2, decimal.mark=",")
roll <- shb1 |>
arrange(year) |>
transmute(year,ts = as.numeric(tong_tai_san),ck = as.numeric(chung_khoan_dau_tu)) |>
mutate(corr3 = zoo::rollapplyr(cbind(ts, ck), 3,function(m) cor(m[,1], m[,2], use="complete.obs"),by.column = FALSE, fill = NA_real_),sign = if_else(corr3 >= 0, "Dương (đồng biến)", "Âm (nghịch biến)"))
pts <- roll |> filter(!is.na(corr3)) |>
{\(d) dplyr::bind_rows(
dplyr::slice_max(d, corr3, n=1, with_ties=FALSE) |> mutate(lbl=paste0("Đỉnh: ", lab_pct01(corr3))),
dplyr::slice_min(d, corr3, n=1, with_ties=FALSE) |> mutate(lbl=paste0("Đáy: ", lab_pct01(corr3))),
dplyr::slice_tail(d, n=1) |> mutate(lbl=paste0("Năm cuối: ", lab_pct01(corr3))))}()
ggplot(roll, aes(year, corr3, fill=sign)) +
geom_col(width=.75, alpha=.9, color=NA) +
geom_hline(yintercept=0, color="grey70", linewidth=.6) +
geom_text(data=pts, aes(label=lbl), vjust=ifelse(pts$corr3>=0, -0.5, 1.2), size=3.1, family="Times New Roman") +
scale_fill_manual(values=c("Dương (đồng biến)"="#16A34A","Âm (nghịch biến)"="#EF4444")) +
coord_cartesian(ylim=c(-1,1)) +
scale_y_continuous(breaks=seq(-1,1,.25), labels=lab_pct01) +
labs(title="TƯƠNG QUAN TRƯỢT 3 NĂM: TỔNG TÀI SẢN vs CK ĐẦU TƯ",
subtitle="Cột dương/âm theo dấu của hệ số; nhãn tại đỉnh, đáy, năm cuối",
x="Năm", y="Hệ số tương quan") +
theme_minimal(base_family="Times New Roman") +
theme(legend.position="top", panel.grid.minor=element_blank(),
plot.title=element_text(face="bold", hjust=.5),
plot.subtitle=element_text(hjust=.5))
Câu lệnh: (3) Lấy cột số cho Tổng TS và CK đầu tư; (4) Tính tương quan trượt 3 năm (pairwise); (5) Gắn nhãn dấu: Dương/Âm; (7) Tìm năm đỉnh và tạo nhãn “Đỉnh: …”; (8) Tìm năm đáy và tạo nhãn “Đáy: …”; (9) Lấy năm cuối và nhãn “Năm cuối: …”; (10) Khởi tạo ggplot: X=năm, Y=corr3, tô theo dấu; (11) Vẽ cột (bar) biểu diễn hệ số; (12) Kẻ đường mốc y=0.
Nhận xét: Biểu đồ cho thấy hệ số tương quan trượt 3 năm giữa Tổng tài sản và Chứng khoán đầu tư biến động rõ rệt theo chu kỳ. Giai đoạn 2015–2018 duy trì tương quan dương mạnh (đỉnh 1,00), phản ánh hai biến tăng song hành khi ngân hàng mở rộng quy mô đầu tư. Tuy nhiên, đến 2019–2020, hệ số chuyển âm mạnh (đáy –0,68), cho thấy xu hướng ngược chiều trong bối cảnh dịch COVID-19 khiến cấu trúc tài sản điều chỉnh. Từ 2021 trở đi, mối liên hệ dương phục hồi dần và đạt 0,70 ở năm cuối, cho thấy sự tái lập tương quan tích cực giữa tăng trưởng tổng tài sản và danh mục đầu tư của SHB.
2.4.3.3 Tỷ trọng và tốc độ tăng trưởng (CAGR) các khoản mục tài sản
lab_pct <- label_percent(accuracy = .1, big.mark = ".", decimal.mark = ",")
lab_num <- label_number(big.mark = ".", decimal.mark = ",")
asset_cols <- c("tien_gui_khach_hang","tien_gui_nhnn","tien_vang_ngoai_te","chung_khoan_kinh_doanh",
"chung_khoan_dau_tu", "gop_von_dai_han","cho_vay_cac_tctd_khac","ts_huu_hinh","ts_vo_hinh","tai_san_khac")
yr_first <- min(shb1$year); yr_last <- max(shb1$year)
long <- shb1 |>select(year, tong_tai_san, all_of(asset_cols))|>pivot_longer(all_of(asset_cols), names_to="khoan_muc", values_to="gia_tri")|>
group_by(year) |> mutate(ty_trong = gia_tri/sum(gia_tri)) |> ungroup() |>
mutate(khoan_muc = recode(khoan_muc,"tien_gui_khach_hang"="Tiền gửi khách hàng","tien_gui_nhnn" ="Tiền gửi NHNN","tien_vang_ngoai_te" ="Tiền, vàng, ngoại tệ","chung_khoan_kinh_doanh"="CK kinh doanh","chung_khoan_dau_tu" ="CK đầu tư","gop_von_dai_han" ="Góp vốn dài hạn","cho_vay_cac_tctd_khac"="Cho vay TCTD khác","ts_huu_hinh" ="Tài sản hữu hình","ts_vo_hinh"="Tài sản vô hình","tai_san_khac" ="Tài sản khác"))
cagr_tbl <- long |>group_by(khoan_muc) |>summarise(share_last = ty_trong[year==yr_last] %>% na.omit() %>% {.[1]},v0 = gia_tri[year==yr_first] %>% na.omit() %>% {.[1]},vT = gia_tri[year==yr_last] %>% na.omit() %>% {.[1]},.groups = "drop") |>
mutate(n = yr_last-yr_first,CAGR = ifelse(v0>0 & vT>0, (vT/v0)^(1/n)-1, NA_real_),size_last = vT)
med_share <- median(cagr_tbl$share_last, na.rm=TRUE)
med_cagr <- median(cagr_tbl$CAGR, na.rm=TRUE)
quad_df <- cagr_tbl |>mutate(grp_share = if_else(share_last > med_share, "Tỷ trọng cao", "Tỷ trọng thấp"),
grp_cagr = if_else(CAGR > med_cagr, "CAGR cao", "CAGR thấp"),
quadrant = factor(paste(grp_cagr, "—", grp_share),levels = c("CAGR cao — Tỷ trọng cao","CAGR cao — Tỷ trọng thấp","CAGR thấp — Tỷ trọng cao","CAGR thấp — Tỷ trọng thấp")))
p <- ggplot(quad_df, aes(share_last, CAGR, size = size_last)) +
geom_point(alpha=.9, colour="#1F3A66", fill="#9DC3E6", shape=21,stroke=.6) +
geom_label_repel(data = subset(quad_df, khoan_muc != "Tiền gửi khách hàng"),
aes(label = khoan_muc),size=3.2, family="Times New Roman",box.padding=.55, point.padding=.35,label.size=.2,label.r=unit(0.15,"lines"),min.segment.length=0, segment.size=.3, segment.alpha=.7,force=2.2, force_pull=1, max.overlaps=Inf, seed=123) +
geom_label_repel(data = subset(quad_df, khoan_muc == "Tiền gửi khách hàng"),aes(label = khoan_muc),size=3.2, family="Times New Roman",direction="y", nudge_y=.03, box.padding=.45, point.padding=.35,label.size=.2, label.r=unit(0.15,"lines"),min.segment.length=0, segment.size=.3, segment.alpha=.7,force=3, force_pull=1, max.overlaps=Inf, seed=123) +
facet_wrap(~ quadrant, ncol = 2, scales = "free",
labeller = ggplot2::labeller(quadrant = ggplot2::label_wrap_gen(width = 18))) +
scale_x_continuous(labels = lab_pct, expand = expansion(mult=c(.05,.10))) +
scale_y_continuous(labels = lab_pct, expand = expansion(mult=c(.06,.14))) +
scale_size_continuous(range = c(2, 9), labels = lab_num,guide = guide_legend(
title = "Giá trị (năm cuối)", nrow = 1, byrow = TRUE,
override.aes = list(fill="#9DC3E6", colour="#1F3A66", alpha=.9, stroke=.6))) +
labs(title = toupper("TỶ TRỌNG – TĂNG TRƯỞNG (CAGR) THEO KHOẢN MỤC"),
subtitle = "Chia 4 ô theo median của CAGR và tỷ trọng",
x = "Tỷ trọng trong tổng tài sản (năm cuối)", y = "CAGR (2014–2023)") +
theme_minimal(base_family="Times New Roman") +
theme(strip.text = element_text(size=10, face="bold",margin=margin(3,6,3,6)),
strip.background = element_rect(fill="#F2F2F2", color=NA),
panel.grid.minor = element_blank(),
panel.grid.major.y = element_line(linetype="dotted", color="gray80", linewidth=.25),
legend.position = "bottom",
legend.direction = "horizontal",
legend.key.width = unit(12,"pt"),
legend.key.height = unit(12,"pt"),
plot.margin = margin(8,8,8,8)) +
theme(plot.title = element_text(face = "bold", hjust = 0.5),
plot.subtitle=element_text(hjust=0.5))
p
Câu lệnh: (2) Tính khoảng năm đầu–cuối của chuỗi dữ liệu; (4) Nhóm theo năm → tính tỷ trọng từng khoản mục trong tổng tài sản; (6) Tính CAGR của từng khoản mục giữa 2 mốc đầu–cuối; (8) Xác định median của CAGR và tỷ trọng, dùng làm ranh giới 4 nhóm; (9) Phân loại nhóm; (10) Khởi tạo biểu đồ phân tán ggplot; (11) Gắn nhãn từng điểm (khoản mục); (12) Chia 4 ô bằng median (facet theo 4 nhóm).
Nhận xét: Nhóm CAGR cao – tỷ trọng cao gồm CK kinh doanh và Tiền gửi NHNN, cho thấy định hướng tăng đầu tư ngắn hạn và dự trữ thanh khoản. Tiền gửi khách hàng có tỷ trọng lớn nhưng tăng chậm, phản ánh nền huy động ổn định. Ngược lại, Cho vay TCTD khác nằm ở nhóm CAGR thấp – tỷ trọng thấp, thể hiện xu hướng thu hẹp giao dịch liên ngân hàng. Các khoản tài sản hữu hình, vô hình, tiền–ngoại tệ, góp vốn dài hạn có tỷ trọng nhỏ nhưng tăng dương, góp phần đa dạng hóa danh mục và củng cố an toàn vốn.
2.4.3.4 Ma trận tương quan giữa các cấu phần tài sản
df_num <- shb %>%
select(where(is.numeric)) %>%
select(where(~ !all(is.na(.))))
stopifnot(is.data.frame(df_num), ncol(df_num) > 1)
cor_mat <- suppressWarnings(cor(df_num, use = "pairwise.complete.obs", method = "spearman"))
vars <- colnames(df_num)
corr <- cor_mat %>%as.data.frame() %>%
rownames_to_column("var1") %>%
pivot_longer(-var1, names_to = "var2", values_to = "rho") %>%
filter(match(var1, vars) <= match(var2, vars)) %>%
mutate(var1 = factor(var1, levels = vars),var2 = factor(var2, levels = vars),
lab = number(rho, accuracy = 0.01, decimal.mark = ","))
ggplot(corr, aes(var2, var1)) +
geom_tile(aes(fill = rho), color = "white") +
geom_text(aes(label = lab), size = 4.5) +
scale_fill_gradient2(low = "#0B7285", mid = "white", high = "#2166ac",midpoint = 0, name = "ρ") + coord_fixed() +
theme_minimal(base_size = 10) +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
panel.grid = element_blank(),
axis.title = element_blank())
Câu lệnh: (3) Tính tương quan Spearman (pairwise complete); (4) Lấy danh sách tên biến; (5) Chuyển ma trận tương quan → dạng dài (var1–var2–rho), giữ nửa tam giác; (6) Cố định thứ tự factor theo vars và tạo nhãn lab (2 số TP, dấu “,”); (7) Khởi tạo heatmap theo cặp biến; (8) Vẽ ô màu theo rho (viền trắng); (9) In giá trị ρ trên ô; (10) Thang màu diverging (xanh–trắng–xanh đậm), mốc 0, tên “ρ”.
Nhận xét: Ma trận tương quan cho thấy cấu trúc tài sản của SHB có sự liên hệ đa chiều giữa các khoản mục. Tổng tài sản có tương quan dương rất mạnh với Tiền gửi khách hàng và Chứng khoán đầu tư, phản ánh xu hướng mở rộng quy mô song hành với tăng huy động và đầu tư. Ngược lại, Chứng khoán đầu tư tương quan âm rõ rệt với Cho vay TCTD khác, cho thấy dòng vốn dịch chuyển giữa hai mảng này. Một số mối liên hệ khác như Góp vốn dài hạn – Tiền gửi khách hàng hay Cho vay TCTD – CK kinh doanh có mức tương quan dương vừa, thể hiện xu hướng biến động cùng chiều ở mức hạn chế.
2.4.3.5 Tương quan giữa tổng tài sản và các khoản mục
stopifnot(exists("shb1"))
num_all <- shb1 %>% dplyr::select(where(is.numeric))
keep <- names(num_all) %>%setdiff(c("year","Year","tong_tai_san")) %>% .[!grepl("^(pct_|g_)", .)]
num <- dplyr::select(num_all, dplyr::all_of(c("tong_tai_san", keep)))
vars <- setdiff(names(num), "tong_tai_san")
stopifnot(length(vars) > 0)
label_map <- c(tong_tai_san = "Tổng tài sản",
chung_khoan_dau_tu = "Chứng khoán đầu tư",
gop_von_dai_han = "Góp vốn dài hạn",
tien_gui_khach_hang = "Tiền gửi khách hàng",
cho_vay_cac_tctd_khac = "Cho vay TCTD khác",
chung_khoan_kinh_doanh = "Chứng khoán kinh doanh",
tien_vang_ngoai_te = "Tiền, vàng & ngoại tệ",
tien_gui_nhnn = "Tiền gửi NHNN",
ts_huu_hinh = "Tài sản hữu hình",
ts_vo_hinh = "Tài sản vô hình",
tai_san_khac = "Tài sản khác")
nice_label <- function(x){
out <- ifelse(x %in% names(label_map), label_map[x], x)
out <- gsub("_", " ", out, fixed = TRUE)
tools::toTitleCase(out)}
lst <- lapply(vars, function(v){x <- num[["tong_tai_san"]]; y <- num[[v]]
data.frame(Bien = v,r_spearman = suppressWarnings(cor(x, y, use="pairwise.complete.obs", method="spearman")),
stringsAsFactors = FALSE)})
corr_tbl <- dplyr::bind_rows(lst) %>%
dplyr::mutate(Bien = nice_label(Bien)) %>%
dplyr::arrange(dplyr::desc(abs(r_spearman)))
plot_df <- corr_tbl %>%
dplyr::mutate(Bien= factor(Bien, levels = rev(Bien)),
lab_txt = scales::number(r_spearman, accuracy = 0.01, decimal.mark = ",", big.mark = "."),
sign = ifelse(r_spearman >= 0, "pos", "neg"),
hjust_in = ifelse(r_spearman > 0, 1.02, -0.02))
thr <- 0.35
big <- plot_df %>% dplyr::filter(abs(r_spearman) >= thr)
small <- plot_df %>% dplyr::filter(abs(r_spearman) < thr) %>%
dplyr::mutate(
hjust_out = ifelse(r_spearman > 0, -0.12, 1.12),
col_txt = ifelse(sign == "pos", "#2A7F83", "#A34747"))
ggplot(plot_df, aes(x = r_spearman, y = Bien, fill = sign)) +
geom_col(width = 0.6, alpha = 0.9, show.legend = FALSE) +
geom_text(data = big,aes(label = lab_txt, hjust = hjust_in),colour = "white", size = 3.8) +
geom_label(data = small,aes(label = lab_txt),
hjust = small$hjust_out,
fill = "white", colour = small$col_txt,
size = 3.6, label.size = 0,
label.padding = unit(0.10, "lines")) +
scale_fill_manual(values = c(pos = "#22B3B7", neg = "#F07C7C")) +
scale_x_continuous(limits = c(-1, 1),expand = expansion(mult = c(0.02, 0.14))) +
coord_cartesian(clip = "off") +
labs(title = "Tương quan giữa tổng tài sản và các khoản mục",x = "Hệ số (ρ)", y = NULL) +
theme_minimal(base_size = 11) +
theme(plot.title = element_text(face = "bold", hjust = .5),
panel.grid.major.y = element_blank(),
plot.margin = margin(t = 10, r = 26, b = 10, l = 10))
Câu lệnh: (22–23) Với từng v: đặt x = tong_tai_san, y = v; (24) Tính hệ số Spearman (pairwise.complete.obs); (27) Sắp theo |r_spearman| giảm dần; (34–35) Tách hai nhóm: |r| ≥ thr (big) và < thr (small); (39) Khởi tạo barplot: x = r_spearman, y = biến, tô theo dấu; (40) Vẽ thanh; (47) Đặt màu fill: dương/xanh, âm/đỏ; (48) Trục X [-1, 1] + đệm.
Nhận xét: Biểu đồ cho thấy Tiền gửi khách hàng có tương quan cao tuyệt đối với Tổng tài sản (ρ=1,00), khẳng định đây là nguồn vốn cốt lõi quyết định quy mô ngân hàng. Các khoản Tài sản hữu hình, Tài sản khác, Tiền gửi NHNN và Tài sản vô hình cũng có tương quan dương mạnh (ρ≈0,88–0,95), phản ánh xu hướng mở rộng đồng pha. Ngược lại, Cho vay TCTD khác và Góp vốn dài hạn có tương quan âm (ρ≈–0,45), cho thấy khi ngân hàng tăng quy mô, các khoản này có xu hướng giảm để giảm rủi ro liên ngân hàng. Chứng khoán đầu tư đồng biến vừa phải (ρ≈0,79) còn Chứng khoán kinh doanh gần như độc lập với tổng tài sản, thể hiện tính linh hoạt và ngắn hạn của danh mục này.