Ngôn ngữ lập trình trong phân tích dữ liệu

1 Các Package sử dụng trong bài phân tích

tidyverse

• Bộ công cụ “xương sống” cho phân tích dữ liệu hiện đại trong R, gồm ggplot2, dplyr, tidyr, readr, purrr, tibble… giúp đọc, xử lý, trực quan hóa và lập trình hài hòa theo triết lý “data tidy”.

scales

• Hỗ trợ định dạng nhãn trục và giá trị (%, đơn vị tiền tệ, phân cách hàng nghìn, log scale…) giúp biểu đồ ggplot2 rõ ràng và chuyên nghiệp hơn.

ggrepel

• Cung cấp geom_text_repel() và geom_label_repel() để nhãn không chồng chéo, giữ biểu đồ gọn, dễ đọc, phù hợp báo cáo PDF/HTML.

ggalluvial

• Vẽ biểu đồ alluvial/Sankey mô tả luồng chuyển dịch giữa nhóm, trạng thái hoặc phân loại theo thời gian một cách trực quan.

GGally

• Mở rộng ggplot2 với các hàm như ggpairs() giúp khám phá tương quan chéo giữa nhiều biến nhanh và đẹp.

viridis

• Cung cấp bảng màu liên tục và rời rạc thân thiện với người mù màu, hiển thị tốt trên màn hình và khi in, tích hợp trực tiếp với ggplot2.

readxl

• Đọc file Excel (.xls, .xlsx) nhanh chóng, không phụ thuộc Excel, giữ ổn định kiểu dữ liệu cho bước phân tích tiếp theo.

kableExtra

• “Trang điểm” bảng từ knitr::kable(): căn lề, đường kẻ, màu nền, gộp ô, giúp bảng trong PDF/HTML đạt chuẩn báo cáo chuyên nghiệp.

modelsummary

• Tự động tóm tắt và so sánh nhiều mô hình (hồi quy tuyến tính, logistic, v.v.) thành bảng rõ ràng, dễ đưa vào báo cáo.

tinytable

• Tạo bảng gọn nhẹ, linh hoạt cho HTML/PDF/Word, giúp kiểm soát định dạng mà không cần quá nhiều phụ thuộc nặng.

DT

• Sinh bảng HTML tương tác (lọc, tìm kiếm, sắp xếp, phân trang), phù hợp cho report HTML và dashboard.

janitor

• Dọn dẹp dữ liệu nhanh với các hàm như clean_names(), kiểm tra trùng lặp, tần suất, phục vụ bước tiền xử lý.

lubridate

• Đơn giản hóa làm việc với ngày/giờ (parse, cộng trừ, trích xuất năm/tháng/quý…), rất hữu ích cho chuỗi thời gian.

zoo

• Hỗ trợ cấu trúc và hàm cho chuỗi thời gian (đặc biệt là chuỗi không đều), là nền cho nhiều phương pháp phân tích time series.

broom

• Chuyển kết quả mô hình (lm, glm, v.v.) sang dạng bảng tibble gọn (tidy, augment, glance), dễ lọc, vẽ, xuất báo cáo.

glmnet

• Cài đặt Lasso, Ridge, Elastic Net cho hồi quy tuyến tính & logistic, dùng để chọn biến và regularization trong mô hình dự báo.

MASS

• Cung cấp nhiều hàm và bộ dữ liệu cổ điển cho thống kê và mô hình hóa, thường được dùng làm nền cho phân tích nâng cao.

car

• Hỗ trợ kiểm định và chẩn đoán mô hình (VIF, các test giả thuyết, đồ thị chẩn đoán…), hữu ích trong hồi quy đa biến.

rsample

• Thiết kế resampling, chia train/test, k-fold cross-validation, đặt nền cho quy trình xây dựng mô hình có kiểm soát.

pROC

• Phân tích và vẽ đường ROC, tính AUC và so sánh đường cong ROC giữa các mô hình phân loại.

rlang

• Cung cấp hạ tầng lập trình cho Tidyverse (tidy evaluation), hỗ trợ viết hàm tùy biến tương thích với dplyr, ggplot2.

tidytext

• Đưa văn bản về dạng “tidy” để phân tích: tần suất từ, sentiment, topic…, tích hợp tự nhiên với dplyr và ggplot2.

textdata

• Cung cấp các bộ từ điển và dữ liệu văn bản (sentiment lexicons, embeddings, v.v.) dùng chung với tidytext và phân tích NLP.

corrplot

• Vẽ ma trận tương quan bằng heatmap/ellipse/symbol, giúp trực quan hóa nhanh mối liên hệ giữa biến.

maps

• Cung cấp dữ liệu bản đồ cơ bản, hỗ trợ vẽ bản đồ và chồng thêm lớp dữ liệu không gian trong ggplot2 hoặc base R.

2 Phân tích bộ dữ liệu cho hồ sơ tín dụng từ The Lending Club Loan

---

Trong bối cảnh ngành cho vay ngang hàng (P2P) ngày càng cạnh tranh, khả năng thẩm định và quản trị rủi ro tín dụng chính là xương sống quyết định sự thành bại và lợi nhuận bền vững. Chúng tôi sẽ bóc tách các yếu tố đa chiều từ đặc điểm nhân khẩu học của người vay, cấu trúc khoản vay, đến các tín hiệu kinh tế v mô,để xây dựng một bức tranh toàn cảnh, sắc nét về rủi ro.

Mục tiêu cốt lõi: Bài phân tích của tôi sẽ cung cấp góc nhìn toàn diện cho các nhà quản trị, để đạt được mục tiêu này, chúng tôi sẽ triển khai một quy trình phân tích dữ liệu có cấu trúc, bao gồm các giai đoạn chính:

• Xác định và Lượng hóa các yếu tố rủi ro trọng yếu:
• Phân khúc Rủi ro Khách hàng:
• Cung cấp Nền tảng cho mô hình hóa dự báo:

2.1 Thiết lập các hàm hỗ trợ

log_info <- function(..., .sep = "") {
  msg <- paste(..., sep = .sep)
  cat(sprintf("[INFO] %s | %s\n", format(Sys.time(), "%Y-%m-%d %H:%M:%S"), msg))
}
safe_parse_num <- function(x) {
  if (is.numeric(x)) as.numeric(x) else readr::parse_number(
    as.character(x),
    locale = readr::locale(grouping_mark = ",", decimal_mark = ".")
  )
}
winsorize_vec <- function(x, probs = c(.01,.99)) {
  if(!is.numeric(x)) return(x)
  qs <- stats::quantile(x, probs, na.rm=TRUE)
  pmin(pmax(x, qs[1]), qs[2])
}
mode_impute <- function(x) {
  if (is.numeric(x)) return(x)
  ux <- unique(x[!is.na(x)])
  if (length(ux)==0) return(x)
  tab <- sort(table(x), decreasing = TRUE)
  x[is.na(x)] <- names(tab)[1]
  x
}
emp_to_years <- function(s) {
  s <- as.character(s)
  dplyr::case_when(
    is.na(s) ~ NA_real_,
    s %in% c("10+ years","10+ Years","10+ năm","10+ năm ","10+yrs") ~ 10,
    s %in% c("< 1 year","<1 year","< 1 năm","<1y") ~ 0.5,
    TRUE ~ suppressWarnings(readr::parse_number(s))
  )
}
need_cols <- function(df, cols) all(cols %in% names(df))
parse_issue_date <- function(x) {
  if (inherits(x, "Date")) return(x)
  as.Date(suppressWarnings(lubridate::parse_date_time(
    as.character(x),
    orders = c("my","bY","Y-m","Y-m-d","d/m/Y","m/d/Y"),
    quiet = TRUE
  )))
}
coalesce_issue_date <- function(df) {
  candidates <- c("issue_d","issue_date","earliest_cr_line",
                  "last_pymnt_d","last_credit_pull_d")
  out <- rep(as.Date(NA), nrow(df))
  for (nm in candidates) if (nm %in% names(df)) {
    d <- parse_issue_date(df[[nm]])
    fill_idx <- is.na(out) & !is.na(d)
    if (any(fill_idx)) out[fill_idx] <- d[fill_idx]
  }
  out
}
sample_rows <- function(df, max_n = 200000, seed = 3698) {
  total <- nrow(df)
  size  <- min(total, max_n)
  if (!is.finite(size) || size <= 0) return(df[0, , drop = FALSE])
  set.seed(seed)
  dplyr::slice_sample(df, n = size)
}

Code này tạo ra một bộ công cụ gồm các hàm nhỏ để xử lý dữ liệu nhất quán và đảm bảo tính nhất quán trong việc phân tích.

• log_info: Ghi lại tiến trình công việc với dấu thời gian.
• safe_parse_num: Chuyển đổi văn bản thành số một cách an toàn, xử lý các ký hiệu như dấu phẩy.
• winsorize_vec: Giảm ảnh hưởng của các giá trị ngoại lai bằng cách kéo chúng về một ngưỡng giới hạn.
• mode_impute: Điền các giá trị thiếu trong cột phân loại bằng giá trị phổ biến nhất.
• emp_to_years: Chuẩn hóa cột thâm niên làm việc từ văn bản thành số năm.
• parse_issue_date: Chuyển đổi các định dạng ngày tháng khác nhau thành một định dạng chuẩn.
• coalesce_issue_date: Tìm và sử dụng ngày hợp lệ đầu tiên từ một danh sách các cột ngày tiềm năng.
• sample_rows: Lấy một mẫu dữ liệu nhỏ hơn để thử nghiệm nhanh.

2.2 Tải dữ liệu thô và kiểm tra tiền phân tích

data_path1 <- if (
  exists("params") && !is.null(params$data_path1)) params$data_path1 else "LC_loan.csv"
if (!file.exists(data_path1)) stop("Không tìm thấy file: ", data_path1)
log_info("Đọc dữ liệu từ: ", data_path1)

## [INFO] 2025-11-08 12:10:42 | Đọc dữ liệu từ: C:/Users/phuc1/OneDrive/Máy tính/LC_loan.csv

loans_raw <- readr::read_csv(data_path1, show_col_types = FALSE) |>
  janitor::clean_names()
n_obs  <- nrow(loans_raw)
n_vars <- ncol(loans_raw)
dup_id_n <- if ("id" %in% names(loans_raw)) {
  loans_raw |> dplyr::count(id, name="n") |> dplyr::summarise(dups=sum(
    pmax(n-1,0))) |> dplyr::pull(dups)
} else NA_integer_
missing_by_col <- sapply(loans_raw, function(x) sum(is.na(x)))
missing_anyrow <- sum(!stats::complete.cases(loans_raw))
quality_tbl <- tibble::tibble(
  column = names(loans_raw),
  missing_n = as.integer(missing_by_col),
  missing_pct = round(100 * missing_by_col / max(n_obs,1), 2)
) |> arrange(desc(missing_n))

Mục tiêu của code là tải dữ liệu, sau đó kiểm tra chất lượng để xử lý.

• Tải và chuẩn bị dữ liệu
  • Code xác định đường dẫn file một cách linh hoạt.
  • Nó kiểm tra file có tồn tại không trước khi đọc để tránh lỗi.
  • Nó dùng readr::read_csv để đọc file và janitor::clean_names để tự động làm sạch tên cột.
• Tính các số liệu tổng quan
  • Số dòng (n_obs) và số cột (n_vars).
  • Số dòng bị trùng lặp dựa trên cột id (dup_id_n).
• Phân tích giá trị thiếu
  • Code đếm số giá trị thiếu trong từng cột.
  • Nó cũng đếm tổng số dòng chứa ít nhất một giá trị thiếu.
• Tạo bảng tóm tắt dữ liệu
  • Kết quả được tổng hợp vào một bảng duy nhất là quality_tbl.
  • Bảng này hiển thị tên cột, số lượng và tỷ lệ phần trăm giá trị thiếu.
  • Các cột được sắp xếp theo tỷ lệ thiếu giảm dần.

2.3 Giới Thiệu Bộ Dữ Liệu Lending Club

Dữ liệu từ LC trong bài phân tích rủi ro tín dụng này nhấn mạnh vào hồ sơ người vay của khách hàng bao gồm:

• id: Mã định danh duy nhất cho mỗi khoản vay.
• issue_d: Ngày khoản vay được giải ngân.
• revenue: Thu nhập hàng năm của người vay.
• dti_n: Tỷ lệ nợ trên thu nhập của người vay (%).
• loan_amnt: Tổng số tiền vay.
• fico_n: Điểm tín dụng FICO của người vay.
• experience_c: Cờ báo có thông tin kinh nghiệm làm việc (1) hay không (0).
• emp_length: Số năm kinh nghiệm làm việc.
• purpose: Mục đích vay vốn (ví dụ: trả nợ, mua xe).
• home_ownership_n: Tình trạng sở hữu nhà (ví dụ: thuê, thế chấp).
• addr_state: Tiểu bang nơi người vay sinh sống.
• zip_code: Ba chữ số đầu của mã bưu điện.
• Default: Biến mục tiêu, báo hiệu khoản vay vỡ nợ (1) hay không (0).
• title: Tiêu đề ngắn của khoản vay do người vay tự nhập.
• desc: Mô tả chi tiết về khoản vay do người vay tự nhập.

2.4 Xây dựng Từ điển Dữ liệu

#--- 1) Bảng meta rút gọn (chỉ giữ var/label/unit) ----
var_meta <- tibble::tribble(
  ~var,              ~label,                  ~unit,
  "id",              "Loan ID",               NA,
  "issue_d",         "Issue date",            NA,
  "revenue",         "Annual income",         "USD/year",
  "dti_n",           "Debt-to-income ",  "%",
  "loan_amnt",       "Loan amount",           "USD",
  "fico_n",          "FICO score",            "score",
  "experience_c",    "Has employment info",   "0/1",
  "emp_length",      "Employment length",     "years",
  "purpose",         "Loan purpose",          "category",
  "home_ownership_n","Home ownership",        "category",
  "addr_state",      "Borrower state",        "category",
  "zip_code",        "Zip (3 digits)",        "category",
  "default",         "Default flag",          "0/1",
  "title",           "User loan title",       "text",
  "desc",            "Description", "text" )
#--- 2) Hàm tóm tắt ----
pNA <- function(x) mean(is.na(x))*100
nuniq <- function(x) dplyr::n_distinct(x, na.rm = TRUE)
pcts  <- function(x) stats::quantile(x, probs = c(.01,.05,.25,.5,.75,.95,.99), 
na.rm = TRUE, names = TRUE)
top_levels <- function(x, k = 5) {
  if (!is.character(x) && !is.factor(x)) return(NA_character_)
  tb <- sort(table(x), decreasing = TRUE)
  tb <- head(tb, k)
  paste0(names(tb), " (", sprintf("%.1f", 100*as.numeric(tb)/sum(tb)), "%)", collapse = "; ")
}
#--- 3) Build data dictionary từ dữ liệu thực ----
build_dict <- function(df, meta_tbl = NULL) {
  stopifnot(is.data.frame(df))
  cols <- names(df)
  stats_tbl <- purrr::map_dfr(cols, function(v) {
    x <- df[[v]]
    miss <- pNA(x)
    uniq <- nuniq(x)
    if (is.numeric(x)) {
      qs  <- pcts(x)
      tibble::tibble(
        var = v, type = "numeric", missing_pct = round(miss,2), n_unique = uniq,
        min = suppressWarnings(min(x, na.rm=TRUE)),
        p01 = unname(qs[1]), p05 = unname(qs[2]), p25 = unname(qs[3]),
        median = unname(qs[4]), mean = suppressWarnings(mean(x, na.rm=TRUE)),
        p75 = unname(qs[5]), p95 = unname(qs[6]), p99 = unname(qs[7]),
        max = suppressWarnings(max(x, na.rm=TRUE)),
        sd  = suppressWarnings(stats::sd(x, na.rm=TRUE)),
        example = NA_character_, top_levels = NA_character_
      )
    } else if (is.logical(x) || (is.integer(x) && uniq<=3)) {
      lv <- top_levels(as.character(x), k = 3)
      tibble::tibble(
        var = v, type = "binary/ordinal", missing_pct = round(miss,2), n_unique = uniq,
        min = NA, p01=NA, p05=NA, p25=NA, median=NA, mean=NA, p75=NA,
  p95=NA, p99=NA, max=NA, sd=NA,
        example = paste(head(unique(x), 3), collapse=", "),
        top_levels = lv
      )
    } else {
      lv <- top_levels(x, k = 5)
      tibble::tibble(
        var = v, type = "categorical/text", missing_pct = round(miss,2), n_unique = uniq,
        min = NA, p01=NA, p05=NA, p25=NA, median=NA, mean=NA, p75=NA, 
    p95=NA, p99=NA, max=NA, sd=NA,
        example = paste(head(unique(x), 3), collapse=", "),
        top_levels = lv
      )
    }
  })
  out <- stats_tbl %>%
    dplyr::left_join(meta_tbl, by = "var") %>%
    dplyr::relocate(var, label, type, unit, missing_pct, n_unique)
  out
}

Code này tạo ra một bảng tóm tắt thống kê cho mọi cột trong dữ liệu LC loan.

• Chuẩn bị các thành phần
  • Định nghĩa var_meta, một bảng chứa thông tin mô tả do con người cung cấp như nhãn (label) và đơn vị (unit).
  • Tạo các hàm nhỏ, chuyên biệt để tính toán các chỉ số: pNA (tỷ lệ thiếu), nuniq (số giá trị duy nhất), pcts (các phân vị), và top_levels (các giá trị phổ biến nhất).
• Xây dựng từ điển với hàm build_dict
  • Hàm này lặp qua từng cột trong dữ liệu của Ta.
  • Nó tự động nhận diện kiểu dữ liệu của mỗi cột là số, nhị phân hay văn bản.
  • Nó áp dụng các phép tính thống kê phù hợp cho từng kiểu.
  • Nó kết hợp kết quả thống kê với thông tin mô tả từ var_meta.
• Kết quả đầu ra
  • Nhận được một bảng (tibble) duy nhất.
  • Mỗi hàng trong bảng này mô tả một cột từ dữ liệu gốc.
  • Các cột của bảng hiển thị tỷ lệ thiếu, số giá trị duy nhất, giá trị trung bình, trung vị, và các cấp độ phổ biến nhất.
  • Bảng này cho cái nhìn tổng quan về chất lượng và cấu trúc dữ liệu để ra quyết định xử lý tiếp theo.

2.5 Định dạng Từ điển để Hiển thị.

# Tạo bảng từ điển gốc từ dữ liệu
dict_tbl <- build_dict(loans_raw, var_meta)

# Sắp xếp: numeric trước → binary/ordinal → categorical/text
dict_tbl <- dict_tbl %>%
  dplyr::arrange(
    factor(type, levels=c("numeric","binary/ordinal","categorical/text")),
    dplyr::desc(!is.na(mean)), var
  )

Code này tạo và sắp xếp lại từ điển dữ liệu để dễ dàng xem xét.

• Dùng hàm build_dict để tạo bảng tóm tắt thống kê cho dữ liệu.
• Sau đó, sắp xếp lại bảng này theo một trật tự logic.
• Các biến số (numeric) được đưa lên đầu tiên.
• Tiếp theo là các biến nhị phân (binary/ordinal).
• Cuối cùng là các biến văn bản (categorical/text).
• Cách sắp xếp này giúp Ta tập trung vào các biến số quan trọng trước.

dict_for_print <- dict_tbl %>%
  dplyr::mutate(
    unit = dplyr::if_else(is.na(.data$unit), "", .data$unit)
  ) %>%
  dplyr::select(tidyselect::any_of(c(
    "var","label","type","unit","missing_pct","n_unique",
    "mean","sd","p25","median","p75"
  )))

Code này tạo ra một phiên bản rút gọn của từ điển dữ liệu, tối ưu cho việc trình bày.

• Thay thế các giá trị NA trong cột unit bằng chuỗi rỗng ("") để bảng hiển thị sạch hơn.
• Chỉ chọn ra một tập hợp các cột quan trọng nhất, loại bỏ các thông tin thống kê chi tiết không cần thiết cho việc hiển thị.

# Nếu chưa có dict_for_print thì tạo nhanh từ dict_tbl
if (!exists("dict_for_print") && exists("dict_tbl")) {
  dict_for_print <- dict_tbl %>%
    dplyr::select(
      var, label, type, unit, missing_pct, n_unique,
      mean, sd, p25, median, p75, expected_sign_on_default
    )
}
stopifnot(exists("dict_for_print"))

Code này là một bước kiểm tra an toàn, đảm bảo đối tượng dict_for_print luôn có sẵn cho các bước tiếp theo.

• Nó kiểm tra nếu dict_for_print chưa tồn tại. Nếu đúng, nó sẽ tạo một phiên bản cơ bản từ dict_tbl.
• Nó dùng stopifnot để xác nhận lần cuối. Nếu đối tượng vẫn thiếu, code sẽ dừng lại ngay lập tức để ngăn các lỗi sau này.

# In một bảng 1 cột (var) hoặc 2 cột (var + <col>), luôn gọi rõ dplyr::
print_one_col <- function(df, col_name, title){
  stopifnot(is.character(col_name), length(col_name) == 1)
  stopifnot(is.data.frame(df))
  # Cột cần lấy
  cols <- if (identical(col_name, "var")) "var" else c("var", col_name)
  # Dùng dplyr::select + tidyselect::any_of để tránh lỗi thiếu cột
  tbl <- df %>% dplyr::select(tidyselect::any_of(cols))
  k <- kbl(
    tbl,
    booktabs  = knitr::is_latex_output(),
    longtable = FALSE,
    linesep   = "",
    escape    = TRUE,
    caption   = title
  )
  if (knitr::is_latex_output()) {
    k %>%
      kable_styling(latex_options = c("HOLD_position","striped","scale_down")) %>%
      column_spec(1, width = "12em") %>%
      { if (ncol(tbl) > 1) column_spec(., 2, width = "20em") else . }
  } else {
    k %>% kable_styling(bootstrap_options = c("striped","condensed","responsive"))
  }
}

Code này tạo ra một hàm print_one_col để gói gọn các lệnh định dạng bảng.

• Hàm này nhận một data frame, tên cột và tiêu đề để tạo ra một bảng.
• Nó tự động nhận biết định dạng đầu ra là PDF hay HTML để áp dụng kiểu dáng phù hợp.
• Sử dụng hàm này để tái sử dụng code và giữ cho báo cáo chính gọn gàng.

2.5.1 Thông tin mô tả biến

stopifnot(exists("dict_tbl"))
dict_clean <- dict_tbl %>%
dplyr::mutate(
unit        = dplyr::if_else(is.na(.data$unit), "", .data$unit),
missing_pct = round(missing_pct, 2),
n_unique    = as.integer(round(n_unique)),
mean        = round(mean,   4),
sd          = round(sd,     4),
p25         = round(p25,    4),
median      = round(median, 4),
p75         = round(p75,    4)
)
tbl1 <- dict_clean %>%
  dplyr::select(tidyselect::any_of(c("var","label","type","unit"))) %>%
  kableExtra::kbl(
    col.names = c("Biến", "Diễn giải", "Kiểu dữ liệu", "Đơn vị"),
    align     = c("l", "l", "c", "c"),
    booktabs  = knitr::is_latex_output(),
    longtable = FALSE,
    linesep   = ""
  )
if (knitr::is_latex_output()) {
  tbl1 <- kableExtra::kable_styling(
    tbl1,
    latex_options = c("HOLD_position","striped"),
    full_width    = FALSE,
    font_size     = 9
  )
} else {
  tbl1 <- kableExtra::kable_styling(
    tbl1,
    bootstrap_options = c("striped","hover","condensed"),
    full_width        = FALSE,
    font_size         = 11
  ) %>%
    kableExtra::column_spec(1, width = "7em")  %>%  # cột var gọn
    kableExtra::column_spec(2, width = "18em")      # cột label dễ đọc, tự xuống dòng
}
tbl1

Biến	Diễn giải	Kiểu dữ liệu	Đơn vị
default	Default flag	numeric	0/1
dti_n	Debt-to-income	numeric	%
experience_c	Has employment info	numeric	0/1
fico_n	FICO score	numeric	score
id	Loan ID	numeric
loan_amnt	Loan amount	numeric	USD
revenue	Annual income	numeric	USD/year
addr_state	Borrower state	categorical/text	category
desc	Description	categorical/text	text
emp_length	Employment length	categorical/text	years
home_ownership_n	Home ownership	categorical/text	category
issue_d	Issue date	categorical/text
purpose	Loan purpose	categorical/text	category
title	User loan title	categorical/text	text
zip_code	Zip (3 digits)	categorical/text	category

Tổng quan các biến

• Biến định lượng: Bạn dùng chúng để đo lường rủi ro tài chính. Chúng gồm loan_amnt, revenue, dti_n, và fico_n.
• Biến định tính: Chúng cung cấp ngữ cảnh về người vay. Chúng gồm purpose và home_ownership_n.
• Biến thời gian: issue_d là biến chính. Bạn dùng nó để tính tuổi khoản vay.
• Biến mục tiêu: default. Bạn dự đoán biến này (1 = vỡ nợ, 0 = trả tốt).
• Biến định danh: id. Bạn dùng nó để kiểm tra, không để dự đoán.

Kế hoạch xử lý dữ liệu

• desc: Tỷ lệ thiếu là 91.16%. Bạn loại bỏ biến này.
• id: Đây là mã định danh. Bạn loại bỏ biến này khỏi mô hình.
• zip_code: Có 945 giá trị. Bạn nhóm các giá trị hiếm hoặc dùng Target Encoding.
• title: Có quá nhiều giá trị. Bạn dùng kỹ thuật NLP để khai thác.
• Biến phân loại (purpose, addr_state): Bạn mã hóa chúng sang dạng số.
• Biến số (revenue, dti_n): revenue bị lệch phải. Bạn dùng biến đổi logarit. Sau đó, bạn chuẩn hóa tất cả các biến số.
• Biến ít giá trị: experience_c có giá trị gần như không đổi. Bạn nên loại bỏ biến này.

2.5.2 Thống kê mô tả

## Bảng 2: Thống kê mô tả — phiên bản dễ nhìn hơn
stopifnot(exists("dict_clean"))
tbl2 <- dict_clean %>%
  dplyr::select(
    tidyselect::any_of(c(
      "var","missing_pct","n_unique",
      "mean","sd","p25","median","p75"
    ))
  ) %>%
  dplyr::mutate(
    # % thiếu: 2 số thập phân
    missing_pct = sprintf("%.2f", missing_pct),
    # số unique: hiển thị gọn, có phân cách nếu cần
    n_unique    = ifelse(
      is.na(n_unique), "",
      formatC(n_unique, format = "d", big.mark = ",")
    ),
    # các thống kê: 2 số thập phân, NA -> rỗng
    dplyr::across(
      c(mean, sd, p25, median, p75),
      ~ ifelse(
        is.na(.x), "",
        formatC(.x, format = "f", digits = 2, big.mark = ",")
      )
    )
  ) %>%
  kableExtra::kbl(
    col.names = c(
      "Biến",
      "Thiếu (%)",
      "Số giá trị\nkhác nhau",
      "Mean",
      "SD",
      "P25",
      "Median",
      "P75"
    ),
    align = c("l","c","r","r","r","r","r","r"),
    booktabs  = knitr::is_latex_output(),
    longtable = FALSE,
    linesep   = ""
  )
if (knitr::is_latex_output()) {
  tbl2 <- kableExtra::kable_styling(
    tbl2,
    latex_options = c("HOLD_position","striped","scale_down"),
    full_width = FALSE,
    font_size = 8
  )
} else {
  tbl2 <- kableExtra::kable_styling(
    tbl2,
    bootstrap_options = c("striped","hover","condensed"),
    full_width = FALSE,
    font_size = 11
  )
}
tbl2

Biến	Thiếu (%)	Số giá trị khác nhau	Mean	SD	P25	Median	P75
default	0.00	2	0.20	0.40	0.00	0.00	0.00
dti_n	0.00	7,068	18.30	11.15	11.82	17.63	24.07
experience_c	0.00	2	1.00	0.00	1.00	1.00	1.00
fico_n	0.00	48	698.16	31.85	672.00	692.00	712.00
id	0.00	1,347,681	56,213,593.23	38,395,009.68	19,706,506.00	57,664,225.00	84,495,046.00
loan_amnt	0.00	1,560	14,408.23	8,715.35	7,975.00	12,000.00	20,000.00
revenue	0.00	65,608	77,369.68	70,362.99	46,600.00	65,000.00	92,000.00
addr_state	0.00	51
desc	91.16	109,540
emp_length	0.00	12
home_ownership_n	0.00	4
issue_d	0.00	139
purpose	0.00	14
title	1.24	61,452
zip_code	0.00	945

Phân tích thống kê mô tả

• Tỷ lệ vỡ nợ: 20%.
• Hồ sơ rủi ro: Điểm FICO trung bình là 698. Đây là mức rủi ro vừa phải.
• Phân phối thu nhập: Thu nhập trung bình (77,370 USD) cao hơn nhiều so với trung vị. Độ lệch chuẩn lớn. Điều này xác nhận phân phối bị lệch phải.
• Phân phối FICO: Điểm FICO tập trung quanh mức trung bình. Phân phối tương đối đối xứng.

2.6 Mã hóa dữ liệu và Trực quan hóa Dữ liệu

2.6.1 Khởi tạo Pipeline và Chuẩn hóa (loans0)

# 1. Bản làm việc gốc cho toàn bộ pipeline sau này
loans0 <- loans_raw
# 2. Chuẩn hoá nhãn cột Default để các chunk sau dùng nhất quán:
if (!("Default" %in% names(loans0)) && ("default" %in% names(loans0))) {
  loans0 <- loans0 %>%
    mutate(
      Default = readr::parse_number(
        as.character(.data[["default"]])))}
# 3. Chuẩn hoá một số field numeric hay gặp:
num_candidates <- c(
  "loan_amnt",   # số tiền vay
  "revenue",     # thu nhập năm ( dùng lại để tạo lti, revenue_w)
  "dti_n",       # DTI chuẩn hoá %
  "fico_n"       # điểm FICO numeric 
  )

Code này bắt đầu quy trình xử lý dữ liệu Nó tạo ra một phiên bản dữ liệu ban đầu sạch sẽ và có cấu trúc.

• Tạo bản sao làm việc
  • Tạo loans0 như một bản sao của dữ liệu thô.
  • Điều này bảo vệ dữ liệu gốc không bị thay đổi.
• Chuẩn hóa biến mục tiêu
  • Chuẩn hóa biến mục tiêu.
  • Code đảm bảo luôn có một cột tên Default với kiểu dữ liệu số (0/1) để sử dụng nhất quán.
• Xác định các biến số chính
  • Tạo num_candidates, một danh sách chứa tên các biến số chính.
  • Điều này giúp Ta dễ dàng tái sử dụng và quản lý chúng trong các bước sau.

2.6.2 Chuyển đổi kiểu dữ liệu (loans1)

loans1 <- loans0 %>%
mutate(
issue_d   = coalesce_issue_date(.),
across(all_of(num_candidates), safe_parse_num),
emp_years = if ("emp_length" %in% names(.)) emp_to_years(emp_length) else NA_real_,
Default   = if ("Default" %in% names(.)) as.integer(readr::parse_number(as.character(
  Default))) else NA_integer_,
purpose   = if ("purpose" %in% names(.)) as.factor(purpose) else factor(NA),
home_ownership_n = if ("home_ownership_n" %in% names(.)) as.factor(home_ownership_n) else factor(NA),
addr_state= if ("addr_state" %in% names(.)) as.factor(addr_state) else factor(NA),
title     = if ("title" %in% names(.)) as.character(title) else NA_character_,
desc      = if ("desc"  %in% names(.))  as.character(desc)  else NA_character_
)

Code này chuyển đổi có hệ thống các cột dữ liệu của Ta về đúng định dạng và tạo ra các đặc trưng mới.

• Chuẩn hóa cột ngày tháng (issue_d) bằng một hàm chuyên dụng.
• Chuyển đổi hàng loạt các cột số (loan_amnt, revenue) sang định dạng số chính xác.
• Tạo ra một cột số mới (emp_years) từ cột thâm niên làm việc (emp_length).
• Ép kiểu các biến phân loại (purpose) và biến mục tiêu (Default) về đúng định dạng (factor, integer).
• Code kiểm tra sự tồn tại của mỗi cột trước khi xử lý để tránh lỗi.

2.6.3 Xây dựng biến mới (loans2)

winsor_probs <- if (exists("params") && !is.null(params$winsor_probs)) params$winsor_probs else c(
  .01,.99)
loans2 <- loans1 %>%
mutate(
lti       = dplyr::if_else(is.finite(revenue) & revenue > 0, loan_amnt/revenue, NA_real_),
revenue_w = if ("revenue" %in% names(.)) winsorize_vec(revenue, winsor_probs) else NA_real_
) %>%
mutate(across(where(is.character), ~na_if(., ""))) %>%
mutate(across(where(is.factor), ~forcats::fct_explicit_na(., na_level = "missing"))) %>%
mutate(across(where(is.character), mode_impute))

Code này làm hai việc chính: tạo ra các biến mới (feature engineering) và xử lý các giá trị thiếu (imputation).

• Tạo biến mới
  • Tạo biến lti (tỷ lệ vay trên thu nhập). Biến này đo lường rủi ro tốt hơn.
  • Tạo biến revenue_w (thu nhập đã xử lý). Biến này giảm ảnh hưởng của các giá trị thu nhập quá cao (ngoại lai).
• Xử lý giá trị thiếu
  • Chuẩn hóa dữ liệu bằng cách chuyển đổi các chuỗi rỗng ("") thành giá trị thiếu (NA).
  • Đối với các biến phân loại (factor), Ta biến giá trị thiếu thành một nhóm mới tên là “missing”. Điều này giúp mô hình nhận biết nếu việc thiếu thông tin là một tín hiệu quan trọng.
  • Đối với các biến ký tự còn lại, Ta điền giá trị thiếu bằng giá trị phổ biến nhất (mode).

2.6.4 Lọc dữ liệu (df_cleaned)

df_cleaned <- loans2 %>%
filter(!is.na(loan_amnt), loan_amnt > 0, !is.na(revenue), revenue > 0) %>%
mutate(
fico_group = if ("fico_n" %in% names(.)) cut(
fico_n, breaks=c(0,580,670,740,800,Inf),
labels=c("Poor","Fair","Good","Very Good","Exceptional"),
right=FALSE, include.lowest=TRUE
) else factor(NA)
)

Code này thực hiện hai bước cuối cùng để hoàn thiện dữ liệu cuẩ ta trước khi phân tích.

• Lọc các dòng không hợp lệ
  • Tạo df_cleaned bằng cách lọc dữ liệu từ loans2.
  • Loại bỏ bất kỳ khoản vay nào có số tiền vay (loan_amnt) hoặc thu nhập (revenue) bị thiếu hoặc bằng 0.
• Tạo biến nhóm FICO
  • Tạo một biến mới là fico_group.
  • Biến này nhóm điểm FICO số (fico_n) thành các hạng mục như ‘Poor’, ‘Fair’, ‘Good’.
  • Việc này giúp mô hình dễ dàng nhận diện các nhóm rủi ro khác nhau.

2.7 Mã hóa biến (df_binned)

2.7.1 Tên data frame chuẩn: df_base

if (exists("df_cleaned")) {
  df_base <- df_cleaned
} else if (exists("df_binned")) {
  df_base <- df_binned
} else {
  df_base <- NULL
}

Code này tạo một data frame chuẩn tên là df_base để đảm bảo có một điểm bắt đầu nhất quán.

• Nó kiểm tra df_cleaned trước. Nếu tồn tại, df_base được gán bằng df_cleaned.
• Nếu không, nó kiểm tra df_binned và gán cho df_base nếu tồn tại.
• Nếu cả hai đều không có, df_base được gán là NULL để tránh lỗi.

2.7.2 Chuẩn hoá biến mục tiêu y (0/1)

if (!is.null(df_base)) {
  nm <- names(df_base)
  yname <- c("Default","default","y","bad","target")
  ycol <- yname[yname %in% nm]
  if (length(ycol)) {
    ycol <- ycol[1]
    df_base <- df_base %>% mutate(.y = as.integer(.data[[ycol]] %in% c(1, "1", TRUE,
                                        "TRUE", "Bad", "bad")))
  } else {
    df_base <- df_base %>% mutate(.y = NA_integer_)
  }
}

Code này tự động tìm và chuẩn hóa biến mục tiêu trong data frame df_base.

• Nó tìm kiếm trong dữ liệu một cột có tên nằm trong danh sách các ứng viên phổ biến như “Default”, “default”, “y”, “bad”, “target”.
• Nếu tìm thấy, nó tạo ra một cột chuẩn hóa mới tên là .y.
• Cột .y này sẽ có giá trị là 1 nếu giá trị gốc là “Bad”, TRUE, 1,… và 0 trong các trường hợp khác.
• Nếu không tìm thấy biến mục tiêu, cột .y vẫn được tạo ra nhưng chứa toàn giá trị NA để đảm bảo tính nhất quán.

2.7.3 Tạo các biến numeric khả dụng

num_candidates <- c("fico_n","fico","fico_score","dti_n","dti",
      "lti","loan_to_income","int_rate","interest_rate")
if (!is.null(df_base)) {
  for (v in num_candidates) {
    if (v %in% names(df_base)) {
      nv <- paste0(v, "_n")
      if (!nv %in% names(df_base)) nv <- sub("_n$","",nv) # tránh double _n
      suppressWarnings(df_base[[nv]] <- as.numeric(df_base[[v]]))
    }
  }
}

Code này tự động tìm và đảm bảo các biến số quan trọng có định dạng số.

• Nó xác định một danh sách các tên biến số thường gặp (num_candidates) như fico, dti, int_rate.
• Nó lặp qua danh sách này. Nếu một tên biến tồn tại trong dữ liệu của Ta, nó sẽ tạo ra một phiên bản mới của biến đó với hậu tố _n (ví dụ: fico_n).
• Phiên bản _n này được đảm bảo có kiểu dữ liệu là số (numeric), sẵn sàng cho các phép toán.
• Quá trình này giúp chuẩn hóa dữ liệu từ nhiều nguồn khác nhau.

2.7.4 Tính toán giá trị Pseudo‑score | p_hat

if (!is.null(df_base)) {
  score_terms <- c("fico_n","fico","dti_n","dti","lti","loan_amnt","int_rate")
  score_terms <- score_terms[score_terms %in% names(df_base)]
  if (length(score_terms)) {
    X <- df_base[score_terms]
    X <- suppressWarnings(mutate_all(X, ~as.numeric(.)))
    # đổi dấu để fico cao → rủi ro thấp
    s <- rep(0, nrow(df_base))
    if ("fico_n" %in% names(X)) s <- s - scale(X$fico_n)
    if ("fico"   %in% names(X)) s <- s - scale(X$fico)
    if ("dti_n"  %in% names(X)) s <- s + scale(X$dti_n)
    if ("dti"    %in% names(X)) s <- s + scale(X$dti)
    if ("lti"    %in% names(X)) s <- s + scale(X$lti)
    if ("loan_amnt" %in% names(X)) s <- s + 0.2*scale(X$loan_amnt)
    if ("int_rate"  %in% names(X)) s <- s + 0.8*scale(X$int_rate)
    z <- as.numeric(scale(s))
    p_hat <- 1/(1+exp(-z))
    df_base <- df_base %>% mutate(.p_hat = p_hat)
  } else {
    df_base <- df_base %>% mutate(.p_hat = NA_real_)
  }
}

Code này tạo ra một biến .p_hat, là một điểm số rủi ro ước tính cho mỗi khoản vay.

• Tạo điểm số tuyến tính (s)
  • Nó chọn các biến quan trọng như fico_n, dti_n, lti.
  • Các biến này được chuẩn hóa (scale) để có cùng thang đo.
  • Chúng được kết hợp lại thành một điểm số tổng hợp s. Dấu cộng hoặc trừ thể hiện mối quan hệ đồng biến hay nghịch biến với rủi ro (ví dụ: FICO cao thì rủi ro thấp nên bị trừ đi).
• Chuyển đổi thành xác suất
  • Điểm số s được đưa qua hàm Sigmoid để biến đổi thành một giá trị .p_hat nằm trong khoảng từ 0 đến 1.
  • .p_hat có thể được diễn giải như một xác suất vỡ nợ ước tính.
  • Biến này rất hữu ích để phân tích và đánh giá mô hình.

2.7.5 Các tiện ích nhỏ

`%has_all%` <- function(x, need) all(need %in% names(x))
.silent_plot <- function(p) { if (inherits(p, "ggplot")) print(p) }
if (!is.null(df_base)) {
  cat("Rows:", nrow(df_base), " | Cols:", ncol(df_base), " | y available? ", any(!is.na(df_base$.y)),
      " | p_hat available? ", any(is.finite(df_base$.p_hat)), "\n")
}

## Rows: 1347681  | Cols: 22  | y available?  TRUE  | p_hat available?  TRUE

Code này tạo ra các hàm hỗ trợ và in ra một bản tóm tắt cuối cùng về dữ liệu.

• Toán tử %has_all%
  • Tạo một toán tử tùy chỉnh để kiểm tra xem một data frame có chứa tất cả các cột Ta cần hay không.
  • Nó giúp code của Ta dễ đọc hơn.
• Hàm .silent_plot()
  • Hàm này chỉ in một đối tượng nếu nó là biểu đồ ggplot.
  • Nó ngăn việc vô tình in các bảng dữ liệu lớn, giúp đầu ra của Ta luôn sạch sẽ.
• Thông báo tóm tắt
  • Code này in ra một dòng tóm tắt trạng thái của df_base.
  • Nó cho Ta biết số dòng, số cột, và liệu các biến quan trọng .y và .p_hat đã được tạo thành công hay chưa.
  • Nó hoạt động như một điểm kiểm tra nhanh để xác nhận pipeline đã chạy đúng.

2.7.6 Rời rạc hóa các biến số liên tục (Phân tổ)

df_binned <- df_cleaned %>%
  mutate(
    dti_band = if ("dti_n" %in% names(.)) cut(
      dti_n, breaks=c(-Inf,5,10,15,20,30,40,Inf),
      labels=c("≤5","5–10","10–15","15–20","20–30","30–40",">40")
    ) else factor(NA),
    emp_band = cut(emp_years, breaks=c(-Inf,1,3,5,10,Inf),
                   labels=c("<1y","1–3y","3–5y","5–10y","10y+")),
    rev_band = cut(revenue_w,
                   breaks=c(0,40e3,60e3,80e3,120e3,200e3,Inf),
                   labels=c("<40k","40–60k","60–80k","80–120k","120–200k",">200k"),
                   right=FALSE),
    lti_band = cut(lti, breaks=c(-Inf,.05,.10,.20,.30,Inf),
                   labels=c("≤5%","5–10%","10–20%","20–30%",">30%"))
  )

Các điểm cắt cho mỗi biến được Ta lựa chọn dựa trên kiến thức ngành và logic kinh doanh.

• dti_band (Tỷ lệ Nợ trên Thu nhập)
  • Ta chia nhỏ các nhóm ở mức DTI thấp vì sự thay đổi rủi ro ở đây nhạy cảm hơn.
  • Các mốc 20% và 30% là các ngưỡng rủi ro phổ biến trong ngành tài chính.
  • Nhóm >40 gom các giá trị rất cao lại để xử lý ngoại lai.
• emp_band (Thâm niên làm việc)
  • Các mốc thời gian (<1y, 3-5y, 10y+) là các cột mốc quan trọng trong sự nghiệp.
  • Chúng giúp Ta đánh giá sự ổn định công việc, một yếu tố dự báo rủi ro quan trọng.
• rev_band (Thu nhập)
  • Các nhóm thu nhập này tương ứng với các phân khúc khách hàng khác nhau.
  • Ta chia nhóm rộng hơn ở mức thu nhập cao. Lý do là sự khác biệt rủi ro giữa thu nhập 40k và 60k quan trọng hơn nhiều so với giữa 200k và 250k.
• lti_band (Tỷ lệ Vay trên Thu nhập)
  • Các nhóm LTI thể hiện các mức độ đòn bẩy tài chính khác nhau.
  • Các ngưỡng 10%, 20%, 30% là các điểm mà Ta giả định rủi ro bắt đầu tăng lên rõ rệt.

3 Phân tích Thống kê và Trực quan hóa bộ dữ liệu LC Loans

---

3.1 Phân tích phân bổ Thu nhập

if (need_cols(df_cleaned, "revenue_w")) {
  x <- suppressWarnings(as.numeric(df_cleaned$revenue_w))
  x <- x[is.finite(x)]
  if (length(x) > 1) {
    theme_name <- "Modern Blue"   
    use_log    <- FALSE           # TRUE để xem trục X dạng log10 (sd khi lệch phải)
    # BẢNG MÀU
    pal <- switch(theme_name,
"Modern Blue" = list(hist_fill="#A7B1C2", hist_line="#7B8794",dens_line="#0F3D5E", dens_fill="#5BA2D0",
  iqr="#DDEAF7", vline_med="#1F2A44", vline_mean="#157347", text_med="#1F2A44",text_mean="#157347")
    )
    # --- Thống kê chính ---
    n   <- length(x)
    q   <- stats::quantile(x, c(.25,.5,.75,.95,.99), na.rm=TRUE, names=TRUE)
    iqr <- stats::IQR(x, na.rm=TRUE)
    mu  <- mean(x, na.rm=TRUE)
    # Binwidth Freedman–Diaconis (đảm bảo tối thiểu 1k)
    bw_fd <- 2 * iqr / (n^(1/3))
    binw  <- max(1000, round(bw_fd, -2))  # làm tròn hàng trăm
    # Giới hạn trục tối ưu (để nhãn không dồn)
    x_max <- max(x, na.rm=TRUE)
    x_breaks <- if (use_log) pretty(log10(x), n=6) else pretty(x, n=6)
    p_tail95 <- mean(x >= q[["95%"]])
    dfp <- data.frame(revenue_w = x)
    p <- ggplot(dfp, aes(x = revenue_w)) +
      # Dải IQR tinh tế
      annotate("rect", xmin=q[["25%"]], xmax=q[["75%"]],
               ymin=0, ymax=Inf, alpha=0.16, fill=pal$iqr) +
      # Histogram (đường viền mảnh để in PDF sắc)
      geom_histogram(binwidth=binw, boundary=0, closed="right",
                     fill=pal$hist_fill, color=pal$hist_line, linewidth=0.25) +
      # Density theo count (bán trong suốt)
      geom_density(aes(y = after_stat(..scaled..) * max(after_stat(count))),
     linewidth=0.75, color=pal$dens_line, fill=pal$dens_fill, alpha=0.22, adjust=1.0) +
      # Vạch P25/Median/P75 + Mean
      geom_vline(xintercept=q[["25%"]], linetype=3, linewidth=0.5, color="#8E8E8E") +
      geom_vline(xintercept=q[["50%"]], linetype=2, linewidth=0.9, color=pal$vline_med) +
      geom_vline(xintercept=q[["75%"]], linetype=3, linewidth=0.5, color="#8E8E8E") +
      geom_vline(xintercept=mu,         linetype=1, linewidth=0.7, color=pal$vline_mean) +
      # Nhãn mốc (dán sát mép trên để không đè thanh)
      annotate("label", x=q[["50%"]], y=Inf, vjust=2.0, size=3.2,
               label=paste0("Median ", dollar(q[["50%"]], accuracy=1)),
               fill="white", color=pal$text_med, label.size=0) +
      annotate("label", x=mu, y=Inf, vjust=3.6, size=3.2,
               label=paste0("Mean ", dollar(mu, accuracy=1)),
               fill="white", color=pal$text_mean, label.size=0) +
      # TRỤC & NHÃN
      {
        if (use_log) {
          scale_x_log10(labels = function(z) dollar(10^z, accuracy=1))
        } else {
          scale_x_continuous(labels = dollar_format(accuracy=1), breaks = x_breaks)
        }
      } +
      scale_y_continuous(labels = comma, expand = expansion(mult = c(0, .10))) +
      labs(
        title    = "Phân bổ Thu nhập năm (winsor 1–99%)",
        subtitle = paste0("n = ", format(n, big.mark=","), 
                          " | Bin ≈ ", dollar(binw),
                          " | Tail ≥ P95: ", percent(p_tail95, accuracy=0.1)),
        x = if (use_log) "Thu nhập (USD, trục log10)" else "Thu nhập (USD)",
        y = "Số khách hàng",
        caption = "IQR band; Đứt = Median; Liền = Mean; đường trơn = mật độ quy mô theo count"
      ) +
      theme_minimal(base_size=11) +
      theme(
        plot.title         = element_text(face="bold"),
        plot.subtitle      = element_text(color="grey20"),
        panel.grid.minor   = element_blank(),
        panel.grid.major.x = element_line(linewidth=0.25, color="grey85"),
        panel.grid.major.y = element_line(linewidth=0.25, color="grey90"),
        axis.title.x       = element_text(margin = margin(t = 6)),
        axis.title.y       = element_text(margin = margin(r = 6)),
        plot.caption       = element_text(size=8, color="grey35")
      )

    print(p)
  } else {
    message("Không đủ dữ liệu revenue_w để vẽ.")
  }
}

Code này tạo ra một biểu đồ chi tiết về phân bổ thu nhập bằng ggplot2. Nó kết hợp nhiều lớp thông tin để Ta có cái nhìn toàn diện.

• Biểu đồ cột (histogram) thể hiện tần suất.
• Đường cong mật độ cho thấy hình dạng phân phối.
• Các đường dọc đánh dấu giá trị trung bình và trung vị.
• Vùng tô màu làm nổi bật 50% dữ liệu trung tâm (khoảng tứ phân vị).

Kết quả:

• Phân phối thu nhập bị lệch phải.
  • Hầu hết khách hàng tập trung ở mức thu nhập thấp đến trung bình, với một số ít người có thu nhập rất cao kéo dài về phía bên phải.
• Giá trị trung bình (Mean: $75,799) lớn hơn giá trị trung vị (Median: $65,000).
  • Điều này xảy ra vì một nhóm nhỏ có thu nhập rất cao đã kéo giá trị trung bình lên.
  • Trung vị ($65,000) đại diện cho một khách hàng điển hình tốt hơn so với trung bình.
• Sự tập trung của dữ liệu.
  • Phần lớn khách hàng có thu nhập từ 25,000 USD đến 100,000 USD.

3.2 Phân tích phân bổ Thâm niên

if (need_cols(df_cleaned, "emp_years")) {
  x <- as.numeric(df_cleaned$emp_years)
  x <- x[is.finite(x)]
  if (length(x) > 1) {
    # Chuẩn hóa phạm vi 0–10+ (gom 10+ về 10)
    x <- pmax(0, pmin(x, 10))
    n   <- length(x)
    qs  <- stats::quantile(x, c(.10,.25,.5,.75,.90), names = TRUE)
    mu  <- mean(x); iqr <- IQR(x)
    bw  <- max(1, round(2*iqr/(n^(1/3))))  # FD rule, tối thiểu 1 năm
    # Bảng để vẽ deciles (10% & 90%) + quartiles + median
    marks <- tibble::tibble(
      stat = c("P10","P25","Median","P75","P90","Mean"),
      value = c(qs[["10%"]], qs[["25%"]], qs[["50%"]], qs[["75%"]], qs[["90%"]], mu),
      linet = c(3,3,2,3,3,1),
      col   = c("#6C7A89","#6C7A89","#2C3E50","#6C7A89","#6C7A89","#1E8449"),
      size  = c(.5,.6,.9,.6,.5,.7)
    )
    p <- ggplot(data.frame(emp_years = x), aes(emp_years)) +
      # IQR band
      annotate("rect", xmin = qs[["25%"]], xmax = qs[["75%"]],
               ymin = 0, ymax = Inf, alpha = 0.10, fill = "#D6EAF8") +
      # Histogram (nền)
      geom_histogram(binwidth = bw, boundary = 0, closed = "right",
                     fill = "#95A5A6", color = "#7F8C8D", linewidth = 0.25) +
      # Density (nhấn)
      geom_density(aes(y = after_stat(..scaled..) * max(after_stat(count))),
                   fill = "#5DADE2", color = "#154360", alpha = .25, linewidth = .6) +
      # Vạch deciles/quartiles/median/mean
      geom_vline(data = marks, aes(xintercept = value, linetype = stat),
                 color = marks$col, linewidth = marks$size, show.legend = FALSE) +
      # Nhãn gắn vào vạch chính
      annotate("label", x = qs[["50%"]], y = Inf, vjust = 2.0, size = 3.2,
               label = paste0("Median ", number(qs[["50%"]], .1), "y"),
               fill = "white", color = "#2C3E50", label.size = 0) +
      annotate("label", x = mu, y = Inf, vjust = 3.6, size = 3.2,
               label = paste0("Mean ", number(mu, .1), "y"),
               fill = "white", color = "#1E8449", label.size = 0) +
      # Trục & nhãn
      scale_x_continuous(breaks = 0:10, limits = c(0, 10),
                         labels = function(z) ifelse(z == 10, "10+", z)) +
      scale_y_continuous(expand = expansion(mult = c(0, .10))) +
      labs(
        title    = "Phân bổ thâm niên làm việc",
        subtitle = paste0("n = ", format(n, big.mark=","), 
                          " | Bin = ", bw, " năm | IQR: ",
                          number(qs[["25%"]], .1), "–", number(qs[["75%"]], .1), " năm"),
        x = "Số năm (0 … 10+)",
        y = "Số khách hàng",
        caption = "Dải xanh: IQR (P25–P75). Vạch: P10/P25/Median/P75/P90 & Mean."
      ) +
      theme_minimal(base_size = 11) +
      theme(
        plot.title         = element_text(face = "bold"),
        plot.subtitle      = element_text(color = "grey20"),
        panel.grid.minor   = element_blank(),
        panel.grid.major.x = element_line(linewidth = 0.25, color = "grey85"),
        panel.grid.major.y = element_line(linewidth = 0.25, color = "grey90"),
        axis.title.x       = element_text(margin = margin(t = 6)),
        axis.title.y       = element_text(margin = margin(r = 6)),
        plot.caption       = element_text(size = 8, color = "grey35")
      )

    print(p)
  }
}

Code này tạo một biểu đồ phân bổ thâm niên làm việc bằng ggplot2.

• Chuẩn hóa dữ liệu, gom tất cả nhân viên có 10 năm kinh nghiệm trở lên vào nhóm “10+”.
• Tạo một bảng điều khiển (marks) để định nghĩa tất cả các đường thống kê (trung bình, trung vị). Cách này giúp code vẽ biểu đồ gọn gàng.
• Biểu đồ kết hợp biểu đồ cột và đường cong mật độ để có cái nhìn đầy đủ.

Kết quả:

• Dữ liệu tập trung ở hai đầu.
  • Nhóm “10+” là nhóm đông nhất.
  • Nhóm dưới 1 năm cũng có số lượng đáng kể.
• Phân bổ có nhiều đỉnh.
  • Phân bổ không phải là một đường cong mượt mà có các đỉnh ở các mốc năm tròn.
• Giá trị trung bình và trung vị đều là 6.0 năm.
  • Điều này cho thấy phần trung tâm của dữ liệu tương đối đối xứng.
• 50% khách hàng trung tâm có thâm niên từ 2 đến 10+ năm.

3.3 Phân tích phân bổ điểm FICO và ngưỡng tín dụng

if (need_cols(df_cleaned, "fico_n")) {
  theme_name <- "Sunset Punch"  
  pal <- switch(theme_name,
    "Sunset Punch" = list( # cam-đỏ-tím nổi bật
      band = c(Poor="#FFF0EE", Fair="#FFEFD6", Good="#F0F6FF", VGood="#EAF8F2", Ex="#F6EDFF"),
      hist_fill="#FF7A59", hist_line="#96361D",
      dens_line="#6C2BD9", dens_fill="#B79BFF",
      median="#5B2C6F", mean="#C0392B", iqr="#FFE3DA")   )
  x <- as.numeric(df_cleaned$fico_n)
  x <- x[is.finite(x)]
  if (length(x) > 1) {
    x  <- pmax(300, pmin(x, 850))
    n  <- length(x)
    qs <- stats::quantile(x, c(.10,.25,.5,.75,.90), names = TRUE)
    mu <- mean(x); iqr <- IQR(x)
    # binwidth “nhìn khỏe” hơn + tránh răng cưa quá nhỏ
    bw <- max(10, round(2*iqr/(n^(1/3))/5)*5)
    bands <- tibble::tribble(
      ~label,          ~xmin, ~xmax, ~fill,
      "Poor",            300,   579,  pal$band["Poor"],
      "Fair",            580,   669,  pal$band["Fair"],
      "Good",            670,   739,  pal$band["Good"],
      "Very Good",       740,   799,  pal$band["VGood"],
      "Exceptional",     800,   850,  pal$band["Ex"]
    )
    p <- ggplot(data.frame(fico = x), aes(fico)) +
      # nền vùng FICO (màu NHẠT để nhấn nội dung chính nhưng vẫn “bắt mắt”)
      geom_rect(data=bands, inherit.aes=FALSE,
                aes(xmin=xmin, xmax=xmax, ymin=-Inf, ymax=Inf, fill=label),
                alpha=0.42, color=NA) +
      scale_fill_manual(values = setNames(as.vector(bands$fill), bands$label), guide="none") +
      # dải IQR (làm nổi vùng trung tâm phân phối)
      annotate("rect", xmin=qs[["25%"]], xmax=qs[["75%"]],
               ymin=0, ymax=Inf, alpha=0.18, fill=pal$iqr) +

      # histogram (khối màu đậm, viền tương phản)
      geom_histogram(binwidth=bw, boundary=300, closed="right",
                     fill=pal$hist_fill, color=pal$hist_line, linewidth=0.35) +
      # density chuẩn hóa theo count để “ôm” histogram
      geom_density(aes(y = after_stat(..scaled..) * max(after_stat(count))),
                   color=pal$dens_line, fill=pal$dens_fill, alpha=0.25, linewidth=1) +
      # median (đứt) & mean (liền) – dùng màu khác nhau để phân biệt
      geom_vline(xintercept=qs[["50%"]], linetype=2, linewidth=1,   color=pal$median) +
      geom_vline(xintercept=mu,          linetype=1, linewidth=0.9, color=pal$mean) +
      # nhãn mốc (label gọn, nền trắng để tương phản tốt)
      annotate("label", x=qs[["50%"]], y=Inf, vjust=2.0, size=3.3,
               label=paste0("Median ", number(qs[["50%"]], 1)),
               fill="white", color=pal$median, label.size=0) +
      annotate("label", x=mu, y=Inf, vjust=3.6, size=3.3,
               label=paste0("Mean ", number(mu, 1)),
               fill="white", color=pal$mean, label.size=0) +
      # trục & nhãn
      scale_x_continuous(limits=c(300,850), breaks=seq(300,850,50)) +
      scale_y_continuous(expand=expansion(mult=c(0,.10))) +
      labs(
        title    = "Phân bổ điểm FICO",
        subtitle = paste0("n = ", format(n, big.mark=","), " | Bin = ", bw,
                          " | IQR: ", number(qs[["25%"]], 1), "–", number(qs[["75%"]], 1)),
        x = "FICO (300–850)", y = "Số khách hàng",
        caption = "Nền vùng FICO nhạt; IQR tô sáng; đứt = Median; liền = Mean;
      đường density mượt, tương phản cao."
      ) +
      theme_minimal(base_size=11) +
      theme(
        plot.title         = element_text(face="bold"),
        plot.subtitle      = element_text(color="grey25"),
        panel.grid.minor   = element_blank(),
        panel.grid.major.x = element_line(linewidth=0.3, color="#ECEFF4"),
        panel.grid.major.y = element_line(linewidth=0.3, color="#E9EDF3"),
        axis.title.x       = element_text(margin=margin(t=6)),
        axis.title.y       = element_text(margin=margin(r=6)),
        plot.caption       = element_text(size=8.5, color="grey35"),
        plot.background    = element_rect(fill="white", colour=NA),
        panel.background   = element_rect(fill="#FAFBFD", colour=NA)
      )
    print(p)
  }
}

Code này tạo ra một biểu đồ phân bổ điểm FICO chi tiết bằng ggplot2.

• Mã hóa kiến thức: Ta tạo một bảng (bands) định nghĩa các khoảng điểm FICO tiêu chuẩn (“Poor”, “Fair”, “Good”).
• Cấu trúc đa lớp:
  • Lớp nền tô màu theo các khoảng FICO để cung cấp ngữ cảnh.
  • Các lớp histogram và đường cong mật độ thể hiện phân bổ dữ liệu.
  • Các đường dọc đánh dấu trung bình và trung vị.

Kết quả:

• Dữ liệu tập trung ở khoảng “Good”.
  • Hầu hết khách hàng có điểm FICO từ 660 đến 740.
  • Đỉnh cao nhất của phân bổ nằm ở ranh giới giữa hai vùng “Fair” và “Good”.
• Phân bổ hơi lệch trái.
  • Có một “đuôi” dài hơn về phía điểm cao.
  • Giá trị trung bình (698) cao hơn một chút so với trung vị (692).
• Ít khách hàng dưới chuẩn.
  • Số lượng khách hàng trong vùng “Poor” (dưới 580) rất thấp.
  • Danh mục cho vay này chủ yếu nhắm đến khách hàng từ mức “Fair” trở lên.
• 50% khách hàng trung tâm có điểm FICO từ 672 đến 712.
  • Khoảng điểm hẹp này cho thấy sự đồng nhất về chất lượng tín dụng trong phần lớn danh mục.

3.4 Phân tích phân bổ số tiền vay

palette_variant <- "MagentaCyan"    
use_log        <- FALSE            # TRUE nếu phân phối lệch phải mạnh
facet_var      <- NULL             # ví dụ "purpose" để facet; NULL để tắt
pal <- switch(palette_variant,
  "MagentaCyan" = list(       # “pop” mạnh, trẻ trung
    hist_fill="#B2ABD2", hist_line="#C21F6A",
    dens_line="#00B7FF", dens_fill="#8BD9FF",
    iqr="#FFE0F0",
    vline_med="#7E0E43", vline_mean="#005B7A",
    text_med="#7E0E43",  text_mean="#005B7A",
    p1="#C21F6A", p99="#00B7FF" ) )
# Dữ liệu
dfp <- df_cleaned %>% mutate(loan_amnt = suppressWarnings(as.numeric(
  loan_amnt))) %>% filter(is.finite(loan_amnt))
if (nrow(dfp) > 1) {
  qs  <- stats::quantile(dfp$loan_amnt, c(.01,.25,.5,.75,.95,.99), na.rm=TRUE, names=TRUE)
  iqr <- IQR(dfp$loan_amnt, na.rm=TRUE)
  mu  <- mean(dfp$loan_amnt, na.rm=TRUE)
  n   <- nrow(dfp)
  # Bin FD, sàn 1,000 USD và làm tròn bội 500
  bw_fd <- 2 * iqr / (n^(1/3))
  binw  <- max(1000, round(bw_fd / 500) * 500)
  p_tail95 <- mean(dfp$loan_amnt >= qs[["95%"]])
  base <- ggplot(dfp, aes(x = loan_amnt)) +
    # Dải IQR (rất nhạt, không lấn biểu đồ)
    annotate("rect", xmin=qs[["25%"]], xmax=qs[["75%"]],
             ymin=0, ymax=Inf, alpha=0.16, fill=pal$iqr) +
    # Histogram
    geom_histogram(binwidth=binw, boundary=0, closed="right",
                   fill=pal$hist_fill, color=pal$hist_line, linewidth=0.25) +
    # Density (chuẩn hóa theo count)
    geom_density(aes(y = after_stat(..scaled..) * max(after_stat(count))),
    linewidth=0.75, color=pal$dens_line, fill=pal$dens_fill, alpha=0.22, adjust=1.0) +
    # Vạch P1/P99 + P25/Median/P75 + Mean
    geom_vline(xintercept=qs[["1%"]],  linetype=3, linewidth=0.4, color=pal$p1) +
    geom_vline(xintercept=qs[["99%"]], linetype=3, linewidth=0.4, color=pal$p99) +
    geom_vline(xintercept=qs[["25%"]], linetype=3, linewidth=0.5, color=pal$hist_line) +
    geom_vline(xintercept=qs[["50%"]], linetype=2, linewidth=0.9, color=pal$vline_med) +
    geom_vline(xintercept=qs[["75%"]], linetype=3, linewidth=0.5, color=pal$hist_line) +
    geom_vline(xintercept=mu,          linetype=1, linewidth=0.7, color=pal$vline_mean) +
    # Nhãn mốc gọn, đồng bộ với màu vạch
    annotate("label", x=qs[["50%"]], y=Inf, vjust=2.0, size=3.2,
             label=paste0("Median ", dollar(qs[["50%"]], 1)),
             fill="white", color=pal$text_med, label.size=0) +
    annotate("label", x=mu, y=Inf, vjust=3.6, size=3.2,
             label=paste0("Mean ", dollar(mu, 1)),
             fill="white", color=pal$text_mean, label.size=0) +
    # Trục X: thường hoặc log10
    {
      if (use_log) {
        scale_x_log10(labels = function(z) dollar(10^z, accuracy=1))
      } else {
        scale_x_continuous(labels = dollar_format(accuracy=1), breaks = pretty(dfp$loan_amnt, n=6))
      }
    } +
    scale_y_continuous(labels = comma, expand = expansion(mult = c(0, .10))) +
    labs(
      title    = "Phân bổ số tiền vay",
      subtitle = paste0("n = ", format(n, big.mark=","),
                        " | Bin ≈ ", dollar(binw),
                        " | Tail ≥ P95: ", percent(p_tail95, 0.1),
                        " | P1=", dollar(qs[['1%']],1), " · P99=", dollar(qs[['99%']],1)),
      x = if (use_log) "Số tiền (USD, trục log10)" else "Số tiền (USD)",
      y = "Số khoản vay",
      caption = "IQR band; đứt = Median; liền = Mean; density theo count; vạch mảnh = P1 & P99"
    ) +
    theme_minimal(base_size=11) +
    theme(
      plot.title         = element_text(face="bold"),
      plot.subtitle      = element_text(color="grey20"),
      panel.grid.minor   = element_blank(),
      panel.grid.major.x = element_line(linewidth=0.25, color="grey85"),
      panel.grid.major.y = element_line(linewidth=0.25, color="grey90"),
      axis.title.x       = element_text(margin = margin(t = 6)),
      axis.title.y       = element_text(margin = margin(r = 6)),
      plot.caption       = element_text(size=8, color="grey35")
    )
  # Facet theo biến nhóm (nếu có)
  p <- if (!is.null(facet_var) && facet_var %in% names(dfp)) {
    dfp <- dfp %>% mutate(`.facet` = forcats::fct_lump_n(.data[[facet_var]], n = 6,
                                other_level = "Other"))
    base + facet_wrap(~ `.facet`, ncol = 3, scales = "fixed")
  } else {
    base
  }
  print(p)
} else {
  message("Không đủ dữ liệu loan_amnt để vẽ.")
}

Code này tạo ra một công cụ biểu đồ tương tác bằng ggplot2 để phân tích phân bổ số tiền vay.

• Cấu trúc tái sử dụng: Code xây dựng một biểu đồ cơ sở (base) chứa các lớp chung. Sau đó, nó kiểm tra các tùy chọn của Ta để quyết định có thêm lớp phân nhóm (facet) hay không.
• Thông tin chi tiết: Biểu đồ hiển thị các đường thống kê cho cả khoảng tứ phân vị (P25-P75) và khoảng 98% dữ liệu (P1-P99).

Kết quả:

• Phân bổ có nhiều đỉnh rõ rệt.
  • Các đỉnh này xuất hiện ở các mốc số tiền chẵn như $10,000, $15,000, $20,000.
  • Điều này phản ánh hành vi của người vay (thường yêu cầu số tiền chẵn) và cấu trúc sản phẩm của người cho vay.
• Đỉnh cao nhất ở mức $10,000.
  • Đây là số tiền vay phổ biến nhất trong tập dữ liệu.
• Phân bổ hơi lệch phải.
  • Giá trị trung bình ($14,408) lớn hơn giá trị trung vị ($12,000), cho thấy sự ảnh hưởng của các khoản vay lớn.
• 98% các khoản vay nằm trong khoảng từ $1,500 đến $35,000.
  • Chỉ 1% các khoản vay có giá trị lớn hơn $35,000.

3.5 Phân tích Pareto mục đích vay

top_n            <- 12
other_label      <- "other"
missing_label    <- "missing"
wrap_width       <- 28
palette_variant  <- "Indigo-Gold"   
pareto_threshold <- 0.80
if (need_cols(df_cleaned, "purpose")) {
  df_cnt <- df_cleaned %>%
    transmute(
      purpose_std = purpose %>%
        as.character() %>% str_squish() %>% str_to_lower() %>%
        fct_explicit_na(missing_label)
    ) %>%
    mutate(purpose_top = fct_lump_n(purpose_std, n = top_n, other_level = other_label)) %>%
    count(purpose_top, name = "n", sort = TRUE) %>%
    mutate(share = n / sum(n)) %>%
    arrange(desc(n)) %>%
    mutate(
      cum_share = cumsum(share),
      label_raw = as.character(purpose_top),
      label     = str_wrap(label_raw, width = wrap_width)
    )
  if (nrow(df_cnt) > 0) {
    # Palette
    pal <- switch(palette_variant,"Indigo-Gold" = c("#BFC4E3","#AAB1D9","#969FD1",
                  "#828CC8","#6E79C0","#E6C95E","#D9B53A" ) )
    bar_fill <- pal[3]; bar_line <- pal[2]
    line_col <- pal[6]; point_col <- pal[7]
    band_col <- alpha(pal[1], .35)
    # Thứ tự nhãn (lớn -> nhỏ) và giới hạn trục
    df_cnt <- df_cnt %>% mutate(label = factor(label, levels = rev(unique(label))))
    max_x  <- max(df_cnt$n) * 1.20
    # Vị trí cắt 80%
    cut_idx   <- which(df_cnt$cum_share >= pareto_threshold)[1]
    cut_x     <- df_cnt$n[cut_idx]
    cut_label <- df_cnt$label[cut_idx]
    total_n   <- sum(df_cnt$n)
    # Dữ liệu đường Pareto (quy đổi cum_share sang trục x)
    df_line <- df_cnt %>%
      mutate(x_line = cum_share * max_x,
             y_line = as.numeric(label))
    # Vẽ
    p <- ggplot(df_cnt, aes(y = label)) +
      # Vùng 80%
      annotate("rect", xmin = -Inf, xmax = cut_x,
               ymin = -Inf, ymax = Inf, fill = band_col, color = NA) +
      # Thanh số lượng
      geom_col(aes(x = n), width = 0.7, fill = bar_fill, color = bar_line, linewidth = 0.25) +
      # Nhãn số & %
      geom_text(aes(x = n, label = paste0(comma(n), " (", percent(share, 0.1), ")")),
                hjust = -0.10, size = 3.2, color = "#2C3E50") +
      # Đường Pareto + điểm (không thừa kế aesthetics)
      geom_line(data = df_line, aes(x = x_line, y = y_line),
                inherit.aes = FALSE, color = line_col, linewidth = 1.0) +
      geom_point(data = df_line, aes(x = x_line, y = y_line),
                 inherit.aes = FALSE, color = point_col, size = 1.8) +
      # Vạch tham chiếu 80%
      geom_vline(xintercept = cut_x, linetype = 3, linewidth = 0.5, color = "#666666") +
      # Trục X chính + trục phụ (tích lũy %)
      scale_x_continuous(
        name = "Số khoản vay",
        labels = comma,
        limits = c(0, max_x),
        expand = expansion(mult = c(0, 0.10)),
        sec.axis = dup_axis(
          name   = "Tích lũy (%)",
          labels = function(z) percent(z / max_x, accuracy = 10),
          breaks = seq(0, max_x, length.out = 6)
        )
      ) +
      labs(
        title    = paste0("Mục đích vay — Pareto (Top ", top_n, ")"),
        subtitle = paste0("Tổng n = ", format(total_n, big.mark = ","), 
                          " · Ngưỡng Pareto: ", percent(pareto_threshold),
                          " · Đạt tại nhóm: ", as.character(cut_label)),
        y = NULL, caption = paste0("Nhóm nhỏ gộp \"", other_label, "\"; thiếu = \"", missing_label,
"\". Thanh = số lượng; đường = tích lũy %. Vùng mờ: phần đóng góp đầu tới 80%.")
      ) +
      theme_minimal(base_size = 11) +
      theme(
        plot.title         = element_text(face = "bold"),
        plot.subtitle      = element_text(color = "grey20"),
        panel.grid.major.y = element_blank(),
        panel.grid.minor   = element_blank(),
        panel.grid.major.x = element_line(linewidth = 0.25, color = "grey85"),
        axis.title.x       = element_text(margin = margin(t = 6)),
        plot.caption       = element_text(size = 8, color = "grey35")
      )

    print(p)
  } else {
    message("Không có dữ liệu mục đích vay sau khi chuẩn hoá.")
  }
}

Code này tạo ra một biểu đồ Pareto để phân tích các mục đích vay.

• Làm sạch và chuẩn hóa cột mục đích vay.
• Gom các mục đích ít phổ biến vào một nhóm “other”.
• Đếm số lượng và tính tỷ lệ phần trăm cho mỗi nhóm.
• Biểu đồ kết hợp hai phần:
  • Các cột thể hiện số lượng khoản vay cho mỗi mục đích.
  • Đường cong thể hiện tỷ lệ phần trăm tích lũy.
  • Vùng tô màu làm nổi bật các mục đích chính chiếm 80% tổng số.

Kết quả:

• Hai mục đích vay chiếm ưu thế tuyệt đối.
  • debt_consolidation (hợp nhất nợ) chiếm 58.0%.
  • credit_card (trả nợ thẻ tín dụng) chiếm 21.9%.
• Biểu đồ xác nhận quy tắc 80/20.
  • Chỉ hai mục đích trên đã chiếm gần 80% tổng số khoản vay.
  • Ba mục đích hàng đầu chiếm hơn 80%.
• Các mục đích còn lại chiếm tỷ lệ rất nhỏ.
  • Các mục đích từ major_purchase trở xuống tạo thành một đuôi dài với tỷ lệ không đáng kể.

3.6 Top 10 bang theo số lượng Khoản vay

# Tùy chỉnh
top_n          <- 10
missing_label  <- "missing"
palette_variant<- "Teal-Orange"    # "Teal-Orange" | "Indigo-Gold" | "Ruby-Slate"
show_median    <- TRUE

pal <- switch(palette_variant,
  "Teal-Orange" = list(seg="#C77880", point="#FF9F40", text="#2C3E50", badge_bg="#EAF4F2" ) )

if (need_cols(df_cleaned,"addr_state")) {

  df_cnt <- df_cleaned %>%
    transmute(state = fct_explicit_na(as.factor(addr_state), missing_label)) %>%
    count(state, name = "n", sort = TRUE)

  total_all <- sum(df_cnt$n)
  df_top <- df_cnt %>%
    slice_head(n = top_n) %>%
    mutate(share_all = n / total_all,
           rank = row_number()) %>%
    arrange(n) %>%                        # nhỏ -> lớn dưới lên
    mutate(state_fac = factor(as.character(state), levels = as.character(state)))

  if (nrow(df_top) > 0) {
    x_max <- max(df_top$n) * 1.18
    x_pad <- x_max * 0.10                 # khoảng trống bên trái cho huy hiệu
    med_x <- stats::median(df_top$n)

    # Nhãn phải: "196,805 • 14.6%"
    df_top <- df_top %>%
      mutate(lbl_right = paste0(comma(n), " \u2022 ", percent(share_all, 0.1)),
             badge_txt = paste0("#", rank, "  ", as.character(state)))

    p <- ggplot(df_top, aes(y = state_fac)) +
      # Vạch median (nếu cần)
      { if (show_median) geom_vline(xintercept = med_x, 
      linetype = 3, color = "grey60", linewidth = 0.5) } +
      # Thân lollipop
      geom_segment(aes(x = 0, xend = n, yend = state_fac),
                   color = pal$seg, linewidth = 3, lineend = "round") +
      geom_point(aes(x = n), color = pal$point, fill = pal$point,
                 size = 3.8, shape = 21, stroke = 0) +
      # Huy hiệu trái: "#rank  STATE" (đặt ở vị trí âm để không đụng trục)
      geom_label(aes(x = -x_pad * 0.35, label = badge_txt),
                 hjust = 1, vjust = 0.5, size = 3.2,
                 fill = pal$badge_bg, color = pal$text, label.size = 0) +
      # Nhãn phải: "số • %"
      geom_text(aes(x = n, label = lbl_right),
                hjust = -0.06, size = 3.2, color = pal$text) +
      # Trục & không gian: mở rộng về bên trái để không bị cắt nhãn
      coord_cartesian(xlim = c(-x_pad, x_max), clip = "off") +
      scale_x_continuous(labels = comma, expand = expansion(mult = c(0, 0.05))) +
      labs(
        title    = paste0("Top ", top_n, " bang có nhiều khoản vay nhất"),
        subtitle = paste0("Tổng quan sát: ", format(total_all, big.mark = ","),
                          if (show_median) " | vạch chấm: median Top 10" else ""),
        x = "Số khoản vay", y = NULL
      ) +
      theme_minimal(base_size = 11) +
      theme(
        plot.title         = element_text(face = "bold"),
        plot.subtitle      = element_text(color = "grey25"),
        panel.grid.major.y = element_blank(),
        panel.grid.minor   = element_blank(),
        panel.grid.major.x = element_line(linewidth = 0.25, color = "grey85"),
        axis.text.y        = element_blank(),          # Ẩn trục Y để không chồng với huy hiệu
        axis.title.x       = element_text(margin = margin(t = 6)),
        plot.margin        = margin(t = 6, r = 28, b = 6, l = 24)  # chừa rìa trái/phải cho nhãn
      )
    print(p)
  } else {
    message("Không có dữ liệu addr_state sau khi chuẩn hoá.")
  }
}

Code này tạo ra một biểu đồ Lollipop Chart để hiển thị 10 bang có số lượng khoản vay lớn nhất.

• Đếm số lượng khoản vay cho mỗi bang và chọn ra 10 bang hàng đầu.
• Sắp xếp dữ liệu và tạo các nhãn cần thiết.
• Biểu đồ sử dụng geom_segment và geom_point để tạo hiệu ứng kẹo mút.
• Dùng các nhãn tùy chỉnh để hiển thị thứ hạng, tên bang và số liệu chi tiết.

Kết quả:

• California (CA) chiếm ưu thế tuyệt đối.
  • Với 196,805 khoản vay, CA chiếm 14.6% tổng danh mục, gần gấp đôi bang đứng thứ hai.
• Bốn bang dẫn đầu chiếm tỷ trọng lớn.
  • Bốn bang California, Texas, New York, và Florida chiếm tổng cộng 38.1% số khoản vay.
• Phân bổ theo quy tắc Pareto.
  • Một số ít các bang chiếm phần lớn số lượng khoản vay, cho thấy sự tập trung về mặt địa lý.
• Giá trị trung vị của top 10.
  • Đường chấm chấm cho thấy giá trị trung vị của top 10 này là khoảng 50,000 khoản vay. Năm bang dẫn đầu đều vượt xa mức này.

3.7 Phân tích tương quan (Thu nhập & Số tiền vay)

palette_variant <- "Ruby-Slate"  
use_log         <- FALSE
bins_2d         <- 60
n_groups_median <- 20
pal <- switch(palette_variant,
  "Ruby-Slate"    = c("#F6ECEE","#EBD7DA","#E3B8BC","#D79DA2","#C77880","#C1D0DC","#A6BAC9","#6A869C" ) )
plot_df <- sample_rows(df_cleaned, max_n = 200000, seed = 3698)
if (need_cols(plot_df, c("loan_amnt","revenue_w"))) {
  df <- plot_df %>%
    transmute(
      revenue = suppressWarnings(as.numeric(revenue_w)),
      loan    = suppressWarnings(as.numeric(loan_amnt))
    ) %>% filter(is.finite(revenue), is.finite(loan))
  if (nrow(df) > 1) {
    # Thống kê
    r_p <- suppressWarnings(cor(df$revenue, df$loan, method="pearson"))
    r_s <- suppressWarnings(cor(df$revenue, df$loan, method="spearman"))
    beta <- unname(coef(lm(loan ~ revenue, data=df))[2])

    med_line <- df %>%
      mutate(g = ntile(revenue, n_groups_median)) %>%
      group_by(g) %>% summarise(x = median(revenue), y = median(loan), .groups="drop") %>%
      arrange(x)
    # Khởi tạo plot
    p <- ggplot(df, aes(revenue, loan)) +
      stat_bin2d(bins=bins_2d, aes(fill=after_stat(count))) +
      scale_fill_gradientn(colours = pal, name = "Count",
                           guide = guide_colourbar(barheight = unit(40,"pt"))) +
      stat_density_2d(color = alpha("black", .25), linewidth = 0.25) +
      geom_path(data=med_line, aes(x=x, y=y), inherit.aes=FALSE,
                color = pal[8], linewidth = 1) +
      geom_point(data=med_line, aes(x=x, y=y), inherit.aes=FALSE,
                 color = pal[8], size = 1.6) +
      geom_smooth(method="lm", se=FALSE, color=pal[6], linewidth=.9, linetype=2) +
      labs(
        title = paste0("Khoản vay ~ Thu nhập (sample: ", comma(nrow(df)), ")"),
        subtitle = paste0("Pearson r=", number(r_p, .01),
                          " · Spearman ρ=", number(r_s, .01),
                          " · β̂=", dollar(beta, .01), " per 1 USD income"),
        x = if (use_log) "Thu nhập (winsorized, log10)" else "Thu nhập (winsorized)",
        y = if (use_log) "Khoản vay (log10)" else "Khoản vay"
      ) +
      theme_minimal(base_size=11) +
      theme(
        plot.title    = element_text(face="bold"),
        plot.subtitle = element_text(color="grey25"),
        panel.grid.minor = element_blank(),
        panel.grid.major = element_line(linewidth=.25, color="grey85"),
        legend.position = "right",
        axis.title.x = element_text(margin=margin(t=6)),
        axis.title.y = element_text(margin=margin(r=6))
      )
    if (use_log) {
      p <- p + scale_x_log10(labels = function(z) dollar(10^z)) +
               scale_y_log10(labels = function(z) dollar(10^z))
    } else {
      p <- p + scale_x_continuous(labels = dollar_format()) +
               scale_y_continuous(labels = dollar_format())
    }
    print(p)
  } else {
    message("Không đủ dữ liệu sau khi làm sạch.")
  }
}

Code này tạo ra một biểu đồ phức hợp để phân tích mối quan hệ giữa thu nhập và số tiền vay, giải quyết vấn đề có quá nhiều điểm dữ liệu.

• Ta lấy một mẫu ngẫu nhiên 200,000 dòng để biểu đồ chạy nhanh hơn.

• Ta tính toán các hệ số tương quan và tạo một đường xu hướng trung vị theo nhóm.

• Biểu đồ sử dụng các lớp sau:

  • Bản đồ nhiệt (stat_bin2d): Tô màu các vùng dựa trên mật độ điểm dữ liệu.
  • Đường đồng mức (stat_density_2d): Vẽ các đường viền quanh các vùng có cùng mật độ.
  • Đường trung vị theo nhóm: Một đường liền nét thể hiện xu hướng trung vị.
  • Đường hồi quy tuyến tính: Một đường nét đứt thể hiện xu hướng tuyến tính tổng thể.

Kết quả:

• Có mối quan hệ đồng biến (dương).
  • Những người có thu nhập cao hơn thường vay số tiền lớn hơn.
• Dữ liệu tập trung ở vùng thu nhập $40k-$100k và khoản vay $5k-$20k.
  • Đây là phân khúc khách hàng chính của danh mục.
• Mối quan hệ có xu hướng bão hòa (phi tuyến).
  • Ở mức thu nhập cao (trên $150k), đường trung vị đi ngang, cho thấy thu nhập tăng thêm không còn dẫn đến việc vay số tiền lớn hơn tương ứng.
  • Số tiền vay trung vị dường như “chạm trần” ở khoảng $20k-$25k.
• Độ phân tán của số tiền vay tăng theo thu nhập.
  • Ở mức thu nhập cao, có sự biến động lớn hơn trong số tiền vay.

3.8 Ma trận Tương quan Spearman

grad_name <- "Blue-Red Strong"   
pal <- switch(grad_name,
  "Blue-Red Strong"     = colorRampPalette(c("#2C7BB6","#92C5DE","#F7F7F7","#F4A582","#D6604D"))(200))
# --- Chuẩn bị dữ liệu ---
num_df <- df_cleaned |> dplyr::select(dplyr::where(is.numeric))
drop_id_like <- c("^id$", "^zip", "customer_", "client_")
num_df2 <- num_df |> dplyr::select(-tidyselect::matches(paste(drop_id_like, collapse="|"), 
                                                  ignore.case = TRUE))
qc <- purrr::map_dfr(num_df2, ~tibble::tibble(n_non_na=sum(!is.na(.x)), n_uniq=dplyr::n_distinct(
  .x, na.rm=TRUE), var_x=stats::var(.x, na.rm=TRUE)), .id="col")
good_cols <- qc |> dplyr::filter(n_uniq>=2, is.finite(var_x), var_x>0) |> dplyr::pull(col)
X <- dplyr::select(num_df2, tidyselect::any_of(good_cols))
if (ncol(X) >= 2) {
  cor_mat <- suppressWarnings(stats::cor(X, use="pairwise.complete.obs", method="spearman"))
  # p-value mask để ẩn ô không ý nghĩa
  p_mat <- matrix(NA_real_, ncol=ncol(X), nrow=ncol(X), dimnames=list(colnames(X), colnames(X)))
  for (i in seq_len(ncol(X))) for (j in i:ncol(X)) {
    xi <- X[[i]]; xj <- X[[j]]; ok <- is.finite(xi)&is.finite(xj)
    if (sum(ok)>=5) { pv <- suppressWarnings(cor.test(xi[ok], xj[ok], method="spearman")$p.value)
      p_mat[i,j] <- p_mat[j,i] <- pv }
  }
  corrplot::corrplot(
    cor_mat,
    method    = "color",
    type      = "lower",
    order     = "hclust",
    col       = pal,          # gradient diverging rõ ràng
    tl.cex    = .8, tl.srt = 45, tl.col = "grey20",
    diag      = FALSE,
    p.mat     = p_mat, sig.level = 0.05, insig = "blank", # ẩn ô không ý nghĩa
    na.label  = " ",
    cl.lim    = c(-1, 1)      # cố định thang -1..1
  )
}

Code này tạo ra một ma trận tương quan để trực quan hóa mối quan hệ giữa các biến số trong dữ liệu.

• Lọc dữ liệu để chỉ giữ lại các biến số phù hợp cho việc phân tích.
• Tính toán ma trận tương quan bằng phương pháp Spearman. Ta dùng phương pháp này vì nó xử lý tốt các giá trị ngoại lai và có thể nhận diện các mối quan hệ không hoàn toàn tuyến tính.
• Tính toán p-value để kiểm tra ý nghĩa thống kê.
• Dùng gói corrplot để vẽ ma trận.
  • Các biến được tự động sắp xếp lại để nhóm các biến có liên quan lại với nhau.
  • Các mối tương quan không có ý nghĩa thống kê sẽ bị ẩn đi, giúp Ta tập trung vào những mối quan hệ quan trọng.

Kết quả:

• Ta thấy một khối màu đỏ và cam rõ rệt.
  • Điều này cho thấy mối tương quan dương mạnh giữa revenue, revenue_w, và loan_amnt.
  • Khối này cũng cho thấy tương quan âm mạnh (màu xanh) giữa lti và revenue.
• Ta nhìn vào hàng Default.
  • Tất cả các màu đều nhạt. Điều này có nghĩa là không có biến số đơn lẻ nào có mối quan hệ rất mạnh với việc vỡ nợ.
• Các mối quan hệ cụ thể với Default:
  • fico_n và emp_years có tương quan âm yếu (màu xanh nhạt): Điểm FICO cao hơn hoặc thâm niên dài hơn có liên quan đến rủi ro vỡ nợ thấp hơn.
  • dti_n và lti có tương quan dương yếu (màu cam nhạt): Tỷ lệ DTI hoặc LTI cao hơn có liên quan đến rủi ro vỡ nợ cao hơn.

3.9 Phân tích Thành phần Chính (PCA)

# ========= 1) Fit PCA =========
pca_df <- df_cleaned %>%
  dplyr::select(loan_amnt, revenue_w, dti_n, fico_n, emp_years, lti) %>%
  dplyr::mutate(dplyr::across(everything(), as.numeric)) %>%
  tidyr::drop_na()

# Giữ cột có sd > 0
keep_pca <- names(pca_df)[sapply(pca_df, function(x){
  s <- stats::sd(x, na.rm = TRUE); is.finite(s) && s > 0
})]
pca_df <- dplyr::select(pca_df, tidyselect::any_of(keep_pca))

pca_res <- NULL
if (nrow(pca_df) > 5 && ncol(pca_df) >= 2) {
  pca_res <- stats::prcomp(pca_df, center = TRUE, scale. = TRUE)
  imp <- summary(pca_res)$importance
  var_expl <- as.numeric(round(100 * imp["Proportion of Variance", ], 1))
  cum_expl <- as.numeric(round(100 * imp["Cumulative Proportion", ], 1))
  eig_vals <- as.numeric(round(pca_res$sdev^2, 3))  # eigenvalues

  pcs <- paste0("PC", seq_along(var_expl))
  df_imp <- tibble::tibble(
    PC = pcs,
    `Eigenvalue` = eig_vals,
    `Variance (%)` = var_expl,
    `Cumulative (%)` = cum_expl  )
  
  # ========= 2) Chọn k (Cumulative ≥ 80%) & đánh dấu =========
  target <- 80
  k_sel <- dplyr::coalesce(which(cum_expl >= target)[1], length(cum_expl))
  df_imp <- df_imp %>%
    mutate(Selected = if_else(row_number() <= k_sel, "True", ""))

  # ========= 3) Bảng trình bày =========
  kbl <- kbl(
    df_imp,
    booktabs = TRUE,
    caption = paste0("PCA — Tỷ lệ phương sai giải thích (k = ", k_sel,
                     ", Cumulative = ", cum_expl[k_sel], "%)")
  ) %>%
    kable_styling(latex_options = c("striped","hold_position"), font_size = 10)

  # Tô nền các hàng được chọn (1..k_sel)
  if (k_sel >= 1) {
    kbl <- kbl %>% row_spec(1:k_sel, bold = TRUE, color = "black", background = "#6E79C0")
  }
  print(kbl)

  # Lưu k & % để dùng ở biplot
  assign("k_sel", k_sel, envir = .GlobalEnv)
  assign("cum_k", cum_expl[k_sel], envir = .GlobalEnv)
}

Table 3.1: PCA — Tỷ lệ phương sai giải thích (k = 4, Cumulative = 84.8%)

PC	Eigenvalue	Variance (%)	Cumulative (%)	Selected
PC1	1.649	27.5	27.5	True
PC2	1.490	24.8	52.3	True
PC3	1.007	16.8	69.1	True
PC4	0.942	15.7	84.8	True
PC5	0.837	13.9	98.7
PC6	0.076	1.3	100.0

Code này thực hiện phân tích thành phần chính (PCA) để giảm số chiều của dữ liệu.

• Chuẩn bị dữ liệu.
  • Ta chọn ra một nhóm các biến số chính (loan_amnt, revenue_w, dti_n,…).
  • Ta chuẩn hóa các biến này. Việc này đảm bảo các biến có giá trị lớn (như revenue_w) không lấn át các biến có giá trị nhỏ (như lti).
• Chạy PCA.
  • PCA tạo ra các biến mới, được gọi là Thành phần Chính (PCs).
  • Mỗi PC là một sự kết hợp của các biến gốc và không tương quan với nhau.
• Phân tích kết quả.
  • Ta tính toán tỷ lệ phương sai (thông tin) mà mỗi PC giải thích được.
  • Ta tìm số lượng PC tối thiểu cần thiết để giải thích ít nhất 80% tổng phương sai.
• Tạo bảng tóm tắt.
  • Bảng này hiển thị kết quả và làm nổi bật các PC được chọn.

Kết quả:

• Ta chỉ cần 4 thành phần chính (PCs) để giải thích 84.8% phương sai.
  • Điều này có nghĩa là Ta có thể thay thế 6 biến số ban đầu bằng 4 biến PC mới này mà không làm mất nhiều thông tin quan trọng.
• PC1 là thành phần quan trọng nhất.
  • Nó một mình giải thích được 27.5% tổng phương sai.
• Tỷ lệ phương sai tích lũy tăng dần.
  • PC1 và PC2 cùng nhau giải thích được 52.3%.
  • Bốn PC đầu tiên cùng nhau vượt qua ngưỡng 80%.
• Ba thành phần chính có Eigenvalue lớn hơn 1.
  • Đây là một quy tắc phổ biến khác để chọn số lượng PC. Nó cũng gợi ý rằng giữ lại 3 hoặc 4 PC là hợp lý.

3.10 Biểu đồ Scree Plot (PCA)

if (exists("df_imp")) { 
  df_scree <- df_imp %>%
    mutate(idx = row_number())

  p_scree <- ggplot(df_scree, aes(x = idx)) +
    geom_col(aes(y = `Variance (%)`), fill = "#6E79C0", width = 0.65) +
    geom_line(aes(y = `Cumulative (%)`), color = "#D9B53A", linewidth = 1) +
    geom_point(aes(y = `Cumulative (%)`), color = "#D9B53A", size = 1.6) +
    geom_hline(yintercept = target, linetype = 3, color = "grey50") +
    geom_vline(xintercept = k_sel, linetype = 3, color = "grey50") +
    scale_x_continuous(
      breaks = df_scree$idx, labels = df_scree$PC,
      expand = expansion(mult = c(0.02, 0.05))
    ) +
    scale_y_continuous(limits = c(0, 100), breaks = seq(0, 100, 10), 
                       labels = function(z) paste0(z, "%")) +
    labs(title = "PCA — Scree plot",subtitle = paste0(
      "Vạch ngang 80% · Vạch dọc tại k = ", k_sel, " (Cumulative = ",
      cum_expl[k_sel], "%)"),  x = NULL, y = "",
      caption = "Cột = Variance%; đường = Cumulative%."
    ) +
    theme_minimal(base_size = 11) +
    theme(
      plot.title    = element_text(face = "bold"),
      plot.subtitle = element_text(color = "grey25"),
      panel.grid.minor = element_blank(),
      panel.grid.major.x = element_line(linewidth = 0.25, color = "grey85")
    )
  print(p_scree)
}

Code này tạo ra một biểu đồ PCA Biplot để trực quan hóa mối quan hệ giữa các biến gốc và các thành phần chính mới.

• Các cột màu tím thể hiện tỷ lệ phương sai mà mỗi PC giải thích được.

• Đường màu vàng thể hiện tỷ lệ phương sai tích lũy khi Ta thêm dần từng PC.

• Các đường chấm chấm đánh dấu ngưỡng 80% và số lượng PC được chọn (k=4)

• Trích xuất tọa độ của các khoản vay (scores) và các vector của biến gốc (loadings) từ kết quả PCA.

• Điều chỉnh tỷ lệ của các vector để chúng hiển thị cân đối trên biểu đồ.

• Xây dựng biểu đồ đa lớp:

  • Một bản đồ nhiệt thể hiện mật độ các khoản vay.
  • Các mũi tên thể hiện các biến gốc.
  • Nhãn được tự động sắp xếp để dễ đọc.

Kết quả:

• Ta thấy sự sụt giảm nhanh chóng của các cột màu tím.
  • Sau PC4, sự đóng góp của các PC tiếp theo giảm đi đáng kể.
  • Điều này gợi ý Ta nên giữ lại 4 PC đầu tiên.
• Biểu đồ xác nhận quyết định chọn k=4.
  • Đường cong màu vàng cắt đường tham chiếu 80% ngay tại PC4.
• Ta thấy được hiệu quả của việc giảm chiều.
  • Bằng cách giữ lại 4 PC, Ta đã nắm bắt được 84.8% thông tin từ 6 biến gốc.
  • PC5 và PC6 đóng góp rất ít.

3.11 PCA Biplot (PC1 & PC2)

pal <- list(bg = c("#EEF0FA","#DDE1F3","#BFC4E3","#9FA6D4","#6E79C0"),
            line = "#D9B53A", arrow = "#2C3E50", text = "#2C3E50")
if (exists("pca_res")) {
  scores <- as.data.frame(pca_res$x[, 1:2])
  loads  <- as.data.frame(pca_res$rotation[, 1:2]); loads$var <- rownames(loads)
  imp <- summary(pca_res)$importance
  vx1 <- round(100*imp["Proportion of Variance",1],1)
  vx2 <- round(100*imp["Proportion of Variance",2],1)
  # Scale vectors để vừa khung
  s1 <- max(abs(scores$PC1)); s2 <- max(abs(scores$PC2))
  l1 <- max(abs(loads$PC1));  l2 <- max(abs(loads$PC2))
  mult <- 0.8 * min(s1/l1, s2/l2)
  loads$PC1s <- loads$PC1 * mult
  loads$PC2s <- loads$PC2 * mult
  p <- ggplot(scores, aes(PC1, PC2)) +
    stat_bin2d(bins = 60, aes(fill = after_stat(count))) +
    scale_fill_gradientn(colours = pal$bg, name = "Count",
                         guide = guide_colourbar(barheight = unit(40, "pt"))) +
    geom_smooth(method = "lm", se = FALSE, color = pal$line, linewidth = .9, linetype = 2) +
    geom_segment(data = loads,
                 aes(x = 0, y = 0, xend = PC1s, yend = PC2s),
          arrow = arrow(length = unit(0.018, "npc")), color = pal$arrow,linewidth = .6) +
    {
      if (requireNamespace("ggrepel", quietly = TRUE)) {
        ggrepel::geom_text_repel(data = loads, aes(PC1s, PC2s, label = var),
                                 size = 3, seed = 3698, color = pal$text, max.overlaps = 50)
      } else {
        geom_text(data = loads, aes(PC1s, PC2s, label = var),
                  size = 3, vjust = -0.6, color = pal$text)
      }
    } +
    labs(
      title = "PCA biplot — PC1 vs PC2",
      subtitle = paste0("Chọn k = ", get0("k_sel", ifnotfound = NA_integer_),
                        " (Cumulative = ", get0("cum_k", ifnotfound = NA_real_), "%)"),
      x = paste0("PC1 (", vx1, "%)"),
      y = paste0("PC2 (", vx2, "%)")
    ) +
    theme_minimal(base_size = 11) +
    theme(
      plot.title    = element_text(face = "bold"),
      plot.subtitle = element_text(color = "grey25"),
      panel.grid.minor = element_blank(),
      panel.grid.major = element_line(linewidth = 0.25, color = "grey85"),
      legend.position = "right",
      axis.title.x = element_text(margin = margin(t = 6)),
      axis.title.y = element_text(margin = margin(r = 6))
    )
  print(p)
}

Code này tạo ra một biểu đồ PCA Biplot để trực quan hóa mối quan hệ giữa các biến gốc và các thành phần chính mới.

• Ta trích xuất tọa độ của các khoản vay (scores) và các vector của biến gốc (loadings) từ kết quả PCA.

• Ta điều chỉnh tỷ lệ của các vector để chúng hiển thị cân đối trên biểu đồ.

• Ta xây dựng biểu đồ đa lớp:

  • Một bản đồ nhiệt thể hiện mật độ các khoản vay.
  • Các mũi tên thể hiện các biến gốc.
  • Nhãn được tự động sắp xếp để dễ đọc.

• Biểu đồ này cho biết các biến gốc đóng góp vào hai thành phần chính đầu tiên như thế nào

• Các mũi tên cùng hướng có tương quan dương.

• Các mũi tên ngược hướng có tương quan âm.

• Các mũi tên vuông góc gần như không tương quan.

• Ta diễn giải PC1 (trục ngang) là quy mô tài chính.

  • Các biến loan_amnt, revenue_w, lti đều chỉ về bên phải.
  • Điều này có nghĩa là các biến này cùng nhau định nghĩa nên trục này.

• Ta diễn giải PC2 (trục dọc) là gánh nặng nợ đối lập với chất lượng tín dụng.

  • dti_n chỉ lên trên.
  • fico_n và emp_years chỉ xuống dưới.
  • Điều này cho thấy sự đối lập giữa hai nhóm biến này.

3.12 Mô phỏng tỷ lệ vỡ nợ tích lũy (MOB)

if (requireNamespace("conflicted", quietly = TRUE)) {
  conflicted::conflicts_prefer(
    dplyr::select, dplyr::filter, dplyr::summarise, dplyr::mutate, dplyr::arrange  ) }
# Bảo đảm có df_cleaned (đã làm sạch) và Default là 0/1
stopifnot(exists("df_cleaned"))
if (!"id" %in% names(df_cleaned)) {
  df_cleaned <- df_cleaned %>% dplyr::mutate(id = dplyr::row_number())
}
if (!is.integer(df_cleaned$Default) && !is.numeric(df_cleaned$Default)) {
  df_cleaned <- df_cleaned %>%
    dplyr::mutate(Default = suppressWarnings(as.integer(Default)))
}
# 1) WoE / IV (hàm + chạy mẫu)
calculate_woe_iv <- function(df, var_name, target_name, epsilon = 1e-4) {
  var_sym    <- rlang::ensym(var_name)
  target_sym <- rlang::ensym(target_name)
  tmp <- df %>%
    dplyr::mutate(
      !!target_sym := suppressWarnings(as.integer(!!target_sym)),
      !!var_sym    := forcats::fct_explicit_na(as.factor(!!var_sym), na_level = "Missing")
    ) %>%
    dplyr::filter(!is.na(!!target_sym)) %>%
    dplyr::group_by(!!var_sym) %>%
    dplyr::summarise(
      n      = dplyr::n(),
      n_bad  = sum(!!target_sym == 1, na.rm = TRUE),
      n_good = sum(!!target_sym == 0, na.rm = TRUE),
      .groups = "drop"
    )
  total_bad  <- sum(tmp$n_bad)
  total_good <- sum(tmp$n_good)
  if (total_bad == 0L || total_good == 0L) {
    warning("Target không có đủ cả 0 và 1. Không thể tính WoE/IV.")
    return(list(woe_table = tmp, iv = NA_real_))
  }
  woe_table <- tmp %>%
    dplyr::mutate(
      pct_total = n / (total_bad + total_good),
      pct_bad   = (n_bad  + epsilon) / total_bad,
      pct_good  = (n_good + epsilon) / total_good,
      woe       = log(pct_good / pct_bad),
      iv_component = (pct_good - pct_bad) * woe
    )
  iv_total <- sum(woe_table$iv_component, na.rm = TRUE)

  var_col <- rlang::as_string(var_sym)
  keep <- c(var_col, "n", "n_good", "n_bad", "pct_total", "pct_good", "pct_bad", "woe", "iv_component")
  woe_table <- woe_table %>%
    dplyr::select(dplyr::any_of(keep)) %>%
    dplyr::arrange(dplyr::desc(.data$woe))

  list(woe_table = woe_table, iv = iv_total)
}
iv_list <- list(
  fico_group = if ("fico_group" %in% names(df_cleaned))
                 calculate_woe_iv(df_cleaned, fico_group, Default) else NULL,
  dti_band   = if ("dti_band"   %in% names(df_cleaned))
                 calculate_woe_iv(df_cleaned, dti_band, Default) else NULL,
  emp_band   = if ("emp_band"   %in% names(df_cleaned))
                 calculate_woe_iv(df_cleaned, emp_band, Default) else NULL,
  rev_band   = if ("rev_band"   %in% names(df_cleaned))
                 calculate_woe_iv(df_cleaned, rev_band, Default) else NULL,
  lti_band   = if ("lti_band"   %in% names(df_cleaned))
                 calculate_woe_iv(df_cleaned, lti_band, Default) else NULL
) %>% purrr::compact()
iv_summary <- tibble::tibble(
  Variable = names(iv_list),
  IV = purrr::map_dbl(iv_list, "iv")
) %>% dplyr::arrange(dplyr::desc(IV))
# 2) Vintage mô phỏng + biểu đồ 
set.seed(3698)
base_df <- df_cleaned %>%
  dplyr::filter(!is.na(issue_d), !is.na(Default)) %>%
  dplyr::select(id, issue_d, Default, fico_group)
nmax <- 5000L
df_sample <- if (nrow(base_df) > nmax) {
  base_df[sample.int(nrow(base_df), nmax), , drop = FALSE]
} else base_df
observation_date <- max(df_sample$issue_d, na.rm = TRUE) %m+% years(2)
max_mob <- floor(as.numeric((interval(min(df_sample$issue_d, na.rm = TRUE),                                
observation_date) / months(1))))
max_mob <- max(3L, max_mob)
hazard_curve <- dbeta(seq(0, 1, length.out = max_mob + 1L), shape1 = 2.5, shape2 = 7)
hazard_curve <- hazard_curve / sum(hazard_curve)
df_panel_simulated <- df_sample %>%
  dplyr::group_by(id) %>%
  dplyr::summarise(
    issue_d          = dplyr::first(issue_d),
    is_default_final = dplyr::first(as.integer(Default)),
    fico_group       = dplyr::first(fico_group),
    report_date      = list(seq.Date(from = dplyr::first(issue_d), to = observation_date, by = "month")),
    .groups = "drop"
  ) %>%
  tidyr::unnest(report_date) %>%
  dplyr::mutate(mob = as.integer(interval(issue_d, report_date) %/% months(1)))
df_status_simulated <- df_panel_simulated %>%
  dplyr::group_by(id) %>%
  dplyr::arrange(report_date, .by_group = TRUE) %>%
  dplyr::mutate(
    prob_default_at_mob = dplyr::if_else(is_default_final == 1L,
      cumsum(hazard_curve[pmin(mob + 1L, length(hazard_curve))]), 0
    ),
    is_defaulted_mob   = as.integer(runif(dplyr::n()) < prob_default_at_mob),
    cumulative_default = cumsum(is_defaulted_mob),
    loan_status        = dplyr::if_else(cumulative_default > 0L, "Defaulted", "Current")
  ) %>%
  dplyr::ungroup()
message("Đã giả lập xong dữ liệu panel (", dplyr::n_distinct(df_status_simulated$id), " tài khoản).")
min_Vintage_n <- 500L
df_Vintage_data <- df_status_simulated %>%
  dplyr::mutate(
    Vintage_quarter = paste0(lubridate::year(issue_d), "-Q", lubridate::quarter(issue_d)),
    is_defaulted    = as.integer(loan_status == "Defaulted")
  ) %>%
  dplyr::add_count(Vintage_quarter, name = "n_Vintage") %>%
  dplyr::filter(n_Vintage >= min_Vintage_n)
df_Vintage_summary <- df_Vintage_data %>%
  dplyr::group_by(Vintage_quarter, id, mob) %>%
  dplyr::summarise(is_defaulted = max(is_defaulted), .groups = "drop") %>%
  dplyr::group_by(Vintage_quarter, id) %>%
  dplyr::arrange(mob, .by_group = TRUE) %>%
  dplyr::mutate(has_defaulted = as.integer(cumsum(is_defaulted) > 0L)) %>%
  dplyr::group_by(Vintage_quarter, mob) %>%
  dplyr::summarise(
    n_total     = dplyr::n_distinct(id),
    n_defaulted = sum(has_defaulted),
    .groups = "drop"
  ) %>%
  dplyr::group_by(Vintage_quarter) %>%
  dplyr::mutate(cumulative_default_rate = n_defaulted / max(n_total, 1L)) %>%
  dplyr::ungroup()
df_Vintage_summary <- df_Vintage_summary %>%
  dplyr::arrange(Vintage_quarter, mob)
df_labels <- df_Vintage_summary %>%
  dplyr::group_by(Vintage_quarter) %>%
  dplyr::filter(mob == max(mob, na.rm = TRUE)) %>%
  dplyr::slice_tail(n = 1) %>%
  dplyr::ungroup()
contrast_col <- "#D6604D"
# --- Vẽ --
x_max <- suppressWarnings(max(df_Vintage_summary$mob, na.rm = TRUE))
label_pad <- max(2L, ceiling(0.08 * x_max))  # chừa biên phải cho nhãn
x_by  <- if (x_max <= 36) 6 else 12          # tick thưa
p_Vintage <- ggplot(
  df_Vintage_summary,
  aes(x = mob, y = cumulative_default_rate, color = Vintage_quarter, group = Vintage_quarter)
) +
  geom_line(linewidth = 0.6, alpha = 0.9) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 0.1)) +
  scale_x_continuous(
    limits = c(0, x_max + label_pad),
    breaks = seq(0, x_max, by = x_by),
    minor_breaks = waiver(),
    expand = expansion(mult = c(0, 0.02))
  ) +
  scale_color_viridis_d(option = "C") +    
  labs(
    title = "Vintage Analysis — Tỷ lệ vỡ nợ tích lũy theo MOB",
    x = "Months on Book (MOB)", y = "Cumulative Default Rate"
  ) +
  theme_minimal(base_size = 11) +
  theme(
    plot.title = element_text(face = "bold"),
    legend.position = "none",               # ẨN LEGEND
    panel.grid.minor = element_blank(),
    axis.text.x = element_text(size = 9, margin = margin(t = 3))
  ) +
  guides(color = "none")                    
#  NHÃN 
if (requireNamespace("ggrepel", quietly = TRUE)) {
  p_Vintage <- p_Vintage +
    ggrepel::geom_label_repel(
      data = df_labels,
      mapping = aes(x = mob, y = cumulative_default_rate, label = Vintage_quarter, color = Vintage_quarter),
      direction = "y",
      nudge_x = ceiling(label_pad * 0.6),
      hjust = 0,
      size = 3,
      segment.color = contrast_col,
      segment.size  = 0.9,
      segment.alpha = 1,
      box.padding = 0.2,
      point.padding = 0.1,
      min.segment.length = 0,
      max.overlaps = Inf,
      # Hộp nền đen, chữ trắng
      fill = "black",
      colour = "white",
      label.size = 0.3,
      label.r = grid::unit(2, "pt"),
      label.padding = grid::unit(2, "pt"),
      show.legend = FALSE
    )
} else {
  p_Vintage <- p_Vintage +
    geom_label(
      data = df_labels,
      aes(x = mob + ceiling(label_pad * 0.6), y = cumulative_default_rate, label = Vintage_quarter, color = Vintage_quarter),
      hjust = 0, size = 3,
      fill = "black", colour = "white", label.size = 0.3,
      label.r = grid::unit(2, "pt"), label.padding = grid::unit(2, "pt"),
      show.legend = FALSE, check_overlap = TRUE
    )
}
print(p_Vintage)

Code này mô phỏng dữ liệu theo chuỗi thời gian để tạo ra một biểu đồ phân tích Vintage.

• Mô phỏng dữ liệu
  • Lấy một mẫu nhỏ các khoản vay để xử lý nhanh hơn.
  • Định nghĩa một “đường cong rủi ro” dựa trên phân phối Beta, mô phỏng thực tế rằng rủi ro vỡ nợ cao nhất trong giai đoạn 12-36 tháng đầu.
  • Ta tạo ra một bảng dữ liệu panel, theo dõi trạng thái vỡ nợ mô phỏng của mỗi khoản vay theo từng tháng (MOB).
• Tổng hợp và vẽ biểu đồ
  • Tổng hợp dữ liệu, tính toán tỷ lệ vỡ nợ tích lũy cho mỗi nhóm (Vintage) theo quý phát hành.
  • Vẽ các đường cong vỡ nợ này bằng ggplot2.
  • Thay vì dùng chú giải, Ta gắn nhãn trực tiếp vào cuối mỗi đường cong để dễ đọc hơn.

Kết quả:

• Các đường cong có hình chữ “S” đặc trưng.
  • Vỡ nợ tăng chậm trong 12 tháng đầu.
  • Tăng nhanh trong giai đoạn 12-36 tháng (giai đoạn rủi ro cao nhất).
  • Đi ngang sau 36 tháng, khi hầu hết các khoản vay rủi ro đã vỡ nợ.
• Hiệu suất của các Vintage khác nhau.
  • Các Vintage từ 2009-2010 (ngay sau khủng hoảng tài chính) có tỷ lệ vỡ nợ cao hơn hẳn.
  • Các Vintage sau đó có hiệu suất tốt hơn.
• Các Vintage gần đây chưa đủ chín.
  • Các đường cong của Vintage 2017-2018 ngắn hơn.
  • Không thể kết luận chúng tốt hơn vì chúng chưa trải qua đủ thời gian để thể hiện hết rủi ro.

3.13 Phân tích biến mục đích vay

df_binned <- df_binned %>%
  mutate(
    purpose_top = forcats::fct_lump_n(purpose, n = 8, other_level = "Other") )
# Tính WoE/IV cho purpose_top 
if (exists("calculate_woe_iv") && "purpose_top" %in% names(df_binned)) {
  result_purpose <- calculate_woe_iv(df_binned, purpose_top, Default)
  print(result_purpose$woe_table)
} else {
  stop("Không tìm thấy hàm 'calculate_woe_iv' hoặc biến 'purpose_top'. Hãy chắc chắn chunk WoE/IV ở trên đã chạy.")
}

## # A tibble: 9 × 9
##   purpose_top             n n_good  n_bad pct_total pct_good pct_bad     woe
##   <fct>               <int>  <int>  <int>     <dbl>    <dbl>   <dbl>   <dbl>
## 1 car                 14647  12494   2153    0.0109   0.0116 0.00800  0.371 
## 2 credit_card        295551 245511  50040    0.219    0.228  0.186    0.203 
## 3 home_improvement    87684  72114  15570    0.0651   0.0669 0.0578   0.145 
## 4 major_purchase      29543  24047   5496    0.0219   0.0223 0.0204   0.0884
## 5 Other               29606  23434   6172    0.0220   0.0217 0.0229  -0.0535
## 6 other               78263  61762  16501    0.0581   0.0573 0.0613  -0.0678
## 7 debt_consolidation 781206 615948 165258    0.580    0.571  0.614   -0.0720
## 8 medical             15606  12197   3409    0.0116   0.0113 0.0127  -0.113 
## 9 small_business      15575  10925   4650    0.0116   0.0101 0.0173  -0.533 
## # ℹ 1 more variable: iv_component <dbl>

3.14 Bản đồ rủi ro WeE/IV

has_ggrepel <- requireNamespace("ggrepel", quietly = TRUE)
# 1. Chuẩn hoá biến purpose_top & tính WoE/IV cho purpose
df_binned <- df_binned %>%
  mutate(
    purpose_top = forcats::fct_lump_n(purpose, n = 8, other_level = "Other") )
if (!exists("calculate_woe_iv")) {
  stop("Không tìm thấy hàm calculate_woe_iv(). Hãy chắc chắn chunk WoE/IV tổng quát đã được chạy trước.")
}
if (!"Default" %in% names(df_binned)) {
  stop("Không tìm thấy biến Default trong df_binned. Hãy chắc chắn Default đã chuẩn hoá 0/1.")
}
result_purpose <- calculate_woe_iv(df_binned, purpose_top, Default)
# 2. Chuẩn bị dữ liệu để vẽ bubble map rủi ro
woe_data_plot <- result_purpose$woe_table %>%
  mutate(
    default_rate = n_bad / n,      # tỷ lệ vỡ nợ quan sát thực tế
    Exposure     = pct_total,      # tỷ trọng danh mục
    purpose_lbl  = stringr::str_wrap(as.character(purpose_top), width = 18)
  )
overall_rate <- sum(woe_data_plot$n_bad) / sum(woe_data_plot$n)
iv_total_text <- paste0("IV tổng thể = ", round(result_purpose$iv, 4))
x_min <- min(woe_data_plot$woe,          na.rm = TRUE)
x_max <- max(woe_data_plot$woe,          na.rm = TRUE)
y_min <- min(woe_data_plot$default_rate, na.rm = TRUE)
y_max <- max(woe_data_plot$default_rate, na.rm = TRUE)
woe_data_plot <- woe_data_plot %>%
  filter(is.finite(woe),
         is.finite(default_rate),
         !is.na(purpose_lbl),
         is.finite(Exposure))
# 3. Vẽ biểu đồ 
p_bubble <- ggplot(woe_data_plot, aes(x = woe, y = default_rate)) +
  geom_vline(xintercept = 0,
             linetype   = "dashed",
             color      = "#C0392B",
             linewidth  = 0.7,
             alpha      = 0.8) +
  geom_hline(yintercept = overall_rate,
             linetype   = "dashed",
             color      = "#2C3E50",
             linewidth  = 0.7,
             alpha      = 0.8) +
  geom_point(
    aes(size = Exposure, fill = purpose_top),
    shape  = 21,
    color  = "black",
    alpha  = 0.7,
    stroke = 0.4
  ) +
  {
    if (has_ggrepel) {
      ggrepel::geom_text_repel(
        data = woe_data_plot,
        aes(label = purpose_lbl),
        size               = 3.2,
        color              = "black",
        segment.color      = "grey50",
        segment.size       = 0.4,
        segment.alpha      = 0.6,
        min.segment.length = 0,      # luôn có đường nối
        point.padding      = 0.6,    # đẩy nhãn khỏi bong bóng
        box.padding        = 0.7,    # đẩy nhãn khỏi nhau
        force              = 3,      # lực đẩy tổng thể
        force_pull         = 0.5,    # kéo bớt về điểm gốc
        nudge_x            = 0.02,   # lệch nhẹ theo trục X
        nudge_y            = 0.005,  # lệch nhẹ theo trục Y
        max.overlaps       = Inf
      )
    } else {
      geom_text(
        data  = woe_data_plot,
        aes(label = purpose_lbl),
        size  = 3.2,
        color = "black",
        vjust = -1
      )
    }
  } +
  annotate(
    "text",
    x = x_min, y = y_max,
    label = "\n\n\nWoE < 0,Risk Group",
    hjust = 0, vjust = 1.1,
    color = "#C0392B",
    size = 3.3,
    fontface = "bold.italic"
  ) +
  annotate(
    "text",
    x = x_max, y = y_min,
    label = "WoE > 0,Safe Group\n\n\n\n\n",
    hjust = 1, vjust = -0.1,
    color = "#1E8449",
    size = 3.1,
    fontface = "italic"
  ) +
  scale_size_continuous(
    name   = "Tỷ trọng danh mục (Exposure)",
    range  = c(4, 16),
    labels = percent_format(accuracy = 0.1),
    guide  = guide_legend(
      title.position = "top",
      override.aes   = list(
        fill   = "grey80",
        alpha  = 0.7,
        shape  = 21,
        color  = "black",
        stroke = 0.4
      )
    )
  ) +
  scale_fill_viridis_d(
    name      = "Mục đích vay (Purpose)",
    option    = "C",
    direction = -1,
    guide     = guide_legend(
      title.position = "top",
      override.aes   = list(
        alpha  = 0.8,
        shape  = 21,
        color  = "black",
        stroke = 0.4,
        size   = 5
      )
    )
  ) +
  scale_y_continuous(
    name   = "Tỷ lệ vỡ nợ (Default rate)",
    labels = percent_format(accuracy = 0.1)
  ) +
  scale_x_continuous(
    name   = "Weight of Evidence (WoE)",
    breaks = pretty_breaks(n = 6)
  ) +
  labs(
    title = "Bản đồ Rủi ro theo Mục đích Vay",
    subtitle = paste0(
      "Trục X: WoE (mức độ tốt/xấu so với trung bình)\n",
      "Trục Y: Tỷ lệ vỡ nợ quan sát thực tế\n",
      "Kích thước bong bóng = Tỷ trọng danh mục.  ",
      iv_total_text
    ),
    caption = paste0(
      "Đường dọc đỏ = WoE = 0 (ranh giới rủi ro trung bình).\n",
      "Đường ngang xám = Tỷ lệ vỡ nợ toàn danh mục = ",
      scales::percent(overall_rate, accuracy = 0.01), "."
    )
  ) +
  theme_minimal(base_size = 11) +
  theme(
    plot.title        = element_text(face = "bold"),
    plot.subtitle     = element_text(color = "grey20"),
    plot.caption      = element_text(size = 8, color = "grey40"),
    panel.grid.minor  = element_blank(),
    panel.grid.major  = element_line(color = "grey90", linewidth = 0.4),
    legend.position   = "bottom",
    legend.box        = "vertical",
    legend.title      = element_text(size = 9),
    legend.text       = element_text(size = 8.5)
  )
print(p_bubble)

Code này tính toán các chỉ số rủi ro và tạo ra một biểu đồ bong bóng để so sánh các mục đích vay khác nhau.

• Gom các mục đích vay ít phổ biến vào nhóm “Other”.

• Tính toán Trọng số của Bằng chứng (WoE) và Giá trị Thông tin (IV) cho mỗi nhóm.

• Tạo một biểu đồ bong bóng, trong đó:

  • Trục X là WoE (mức độ rủi ro so với trung bình).
  • Trục Y là tỷ lệ vỡ nợ thực tế.
  • Kích thước bong bóng thể hiện tỷ trọng trong danh mục.

Kết quả:

• Nhóm rủi ro cao (WoE < 0).
  • Vay kinh doanh nhỏ (small_business) có rủi ro cao nhất. Nó có tỷ lệ vỡ nợ cao và WoE thấp nhất.
  • Hợp nhất nợ (debt_consolidation) có rủi ro cao hơn mức trung bình một chút.
• Nhóm an toàn (WoE > 0).
  • Vay mua xe (car) là an toàn nhất. Nó có tỷ lệ vỡ nợ thấp và WoE cao nhất.
  • Trả nợ thẻ tín dụng (credit_card) cũng là một nhóm an toàn.
• Nhóm có tỷ trọng lớn nhất.
  • Hợp nhất nợ và trả nợ thẻ tín dụng là hai bong bóng lớn nhất, chiếm phần lớn danh mục của Ta.

3.15 Dòng chảy trạng thay các khoản vay

if (exists("df_cleaned") &&
    all(c("issue_d","Default") %in% names(df_cleaned))) {
  set.seed(3698)

  # 1) Ma trận chuyển trạng thái (roll-rate matrix) GIẢ LẬP

  state_names <- c("Current", "30 DPD", "60 DPD", "90 DPD", "Defaulted")

  good_trans_matrix <- matrix(c(
    0.95, 0.05, 0.00, 0.00, 0.00,  # Current -> ...
    0.50, 0.40, 0.10, 0.00, 0.00,  # 30 DPD
    0.60, 0.10, 0.20, 0.10, 0.00,  # 60 DPD
    0.70, 0.05, 0.05, 0.10, 0.10,  # 90 DPD
    0.00, 0.00, 0.00, 0.00, 1.00   # Defaulted (absorbing)
  ), nrow = 5, byrow = TRUE,
  dimnames = list(state_names, state_names))

  bad_trans_matrix <- matrix(c(
    0.70, 0.20, 0.10, 0.00, 0.00,  # Current -> ...
    0.10, 0.60, 0.20, 0.10, 0.00,  # 30 DPD
    0.05, 0.10, 0.40, 0.30, 0.15,  # 60 DPD
    0.00, 0.05, 0.10, 0.35, 0.50,  # 90 DPD
    0.00, 0.00, 0.00, 0.00, 1.00   # Defaulted (absorbing)
  ), nrow = 5, byrow = TRUE,
  dimnames = list(state_names, state_names))

  simulate_loan_status <- function(previous_status, loan_type_flag) {
    # previous_status: trạng thái ở tháng t
    # loan_type_flag: 0 = hồ sơ "tốt" (không default cuối cùng), 1 = "xấu"
    if (previous_status == "Defaulted") return("Defaulted")

    prev_idx <- match(previous_status, state_names)

    next_idx <- if (loan_type_flag == 0L) {
      sample.int(5, size = 1, prob = good_trans_matrix[prev_idx, ])
    } else {
      sample.int(5, size = 1, prob = bad_trans_matrix[prev_idx, ])
    }

    state_names[next_idx]
  }

  # 2) Chuẩn bị panel theo tháng (MOB) cho từng khoản vay

  base_df <- df_cleaned %>%
    filter(!is.na(issue_d), !is.na(Default)) %>%
    mutate(
      id_tmp = if ("id" %in% names(df_cleaned)) id else row_number()
    ) %>%
    select(
      id      = id_tmp,
      issue_d,
      Default
    )

  # dùng hàm sample_rows() đã định nghĩa ở phần function trong báo cáo
  df_sample <- sample_rows(base_df, max_n = 5000, seed = 3698)

observation_date <- max(df_sample$issue_d, na.rm = TRUE) %m+% years(2)

  df_panel_simulated <- df_sample %>%
    group_by(id) %>%
    summarise(
      issue_d          = first(issue_d),
      is_default_final = first(Default),    # nhãn "bad" cuối cùng
      report_date      = list(seq.Date(
        from = first(issue_d),
        to   = observation_date,
        by   = "month"
      )),
      .groups = "drop"
    ) %>%
    unnest(report_date) %>%
    mutate(
      mob = as.integer(interval(issue_d, report_date) %/% months(1))
    )

  # 3) Sinh chuỗi trạng thái từng tháng bằng Markov simulation
  
  df_status_simulated <- df_panel_simulated %>%
    group_by(id) %>%
    arrange(mob, .by_group = TRUE) %>%
    mutate(
      loan_status = purrr::accumulate(
        .x    = is_default_final,  # 0/1 lặp cho từng hàng theo thời gian
        .f    = ~ simulate_loan_status(previous_status = .x,
                                       loan_type_flag = .y),
        .init = "Current"
      )[-1]  # bỏ phần tử khởi tạo đầu tiên
    ) %>%
    ungroup() %>%
    mutate(
      loan_status = factor(loan_status, levels = state_names)
    )
 
  # 4) Thêm trạng thái tháng t (loan_status_t0) để tạo cặp from->to

  df_status_simulated <- df_status_simulated %>%
    group_by(id) %>%
    arrange(mob, .by_group = TRUE) %>%
    mutate(
      loan_status_t0 = dplyr::lag(loan_status, order_by = mob)
    ) %>%
    ungroup() %>%
    filter(!is.na(loan_status_t0))

  message("Đã giả lập xong panel trạng thái nợ quá hạn theo thời gian.")

  # 5) Gom chuyển dịch trạng thái (t -> t+1), bỏ các trường hợp không đổi (Current -> Current, v.v.)

  sankey_data <- df_status_simulated %>%
    count(loan_status_t0, loan_status, name = "n", sort = TRUE) %>%
    rename(from = loan_status_t0, to = loan_status) %>%
    filter(from != to)

  # Đặt factor theo mức độ rủi ro, để legend/order ổn định
  sankey_data <- sankey_data %>%
    mutate(
      from = factor(from, levels = state_names),
      to   = factor(to,   levels = state_names)
    )

  # Tổng số luồng để đưa vào subtitle
  total_flow <- sum(sankey_data$n, na.rm = TRUE)

  # 6) VẼ SANKEY (PHIÊN BẢN TRÌNH BÀY CHUYÊN NGHIỆP)

  # Palette “risk escalation” nhẹ, phù hợp báo cáo quản trị rủi ro
  pro_colors <- c(
  "Current"   = "#007BFF",  # Xanh dương sáng (thay vì navy)
  "30 DPD"    = "#FFC107",  # Vàng (warning) chuẩn
  "60 DPD"    = "#FD7E14",  # Cam (orange) rực rỡ
  "90 DPD"    = "#DC3545",  # Đỏ (danger) chuẩn
  "Defaulted" = "#6C757D"   # Xám (secondary) trung tính
)

  p_sankey <- ggplot(
    sankey_data,
    aes(axis1 = from, axis2 = to, y = n)
  ) +
    # Luồng chuyển trạng thái
    geom_alluvium(
      aes(fill = from),
      width     = 0.28,
      knot.pos  = 0.45,
      color     = alpha("grey20", 0.4),
      alpha     = 0.85,
      linewidth = 0.3
    ) +

    # Các "cột trạng thái"
    geom_stratum(
      width     = 0.28,
      fill      = "white",
      color     = "grey25",
      linewidth = 0.4,
      alpha     = 0.9
    ) +

    # Nhãn trên mỗi trạng thái
    geom_text(
      stat     = "stratum",
      aes(label = after_stat(stratum)),
      size     = 3.4,
      color    = "#1F2A44",
      fontface = "bold",
      family   = "sans"
    ) +

    # Nhãn cho hai trục thời gian
    scale_x_discrete(
      limits = c("Trạng thái tháng t", "Trạng thái tháng t+1"),
      expand = c(0.05, 0.05)
    ) +

    # Trục Y = volume
    scale_y_continuous(
      labels = scales::comma,
      expand = expansion(mult = c(0, .03))
    ) +

    # Màu theo trạng thái ban đầu
    scale_fill_manual(
      values = pro_colors,
      name   = "Trạng thái tại tháng t"
    ) +

    labs(
      title    = "Dòng chảy trạng thái tín dụng (Roll-rate Sankey)",
      subtitle = paste0(
        "Luồng chuyển dịch giữa các bucket trễ hạn: Current → 30/60/90 DPD → Defaulted.\n",
        "N = ", scales::comma(total_flow),
        " chuyển động giữa tháng t và tháng t+1 (mô phỏng Markov dựa trên hồ sơ tốt/xấu cuối kỳ)."
      ),
      x        = NULL,
      y        = "Số khoản vay chuyển trạng thái",
      caption  = "Màu = trạng thái tại tháng t. DPD = Days Past Due (số ngày trễ hạn)."
    ) +

    # Theme phong cách 'Modern Blue' (đồng bộ báo cáo)
    theme_minimal(base_size = 11) +
    theme(
      plot.title = element_text(
        face   = "bold",
        color  = "#1F2A44",
        size   = 12,
        family = "sans"
      ),
      plot.subtitle = element_text(
        color      = "grey30",
        size       = 9.5,
        lineheight = 1.2
      ),

      axis.text.y        = element_blank(),
      axis.title.y       = element_text(
        margin = margin(r = 6),
        color  = "grey30",
        size   = 9
      ),
      axis.ticks.y       = element_blank(),

      panel.grid.major.y = element_blank(),
      panel.grid.minor.y = element_blank(),
      panel.grid.major.x = element_blank(),
      panel.grid.minor.x = element_blank(),

      legend.position    = "bottom",
      legend.direction   = "horizontal",
      legend.title       = element_text(
        face  = "bold",
        size  = 8.5,
        color = "#1F2A44"
      ),
      legend.text        = element_text(
        size  = 8,
        color = "grey20"
      ),
      legend.key.height  = unit(10, "pt"),
      legend.key.width   = unit(16, "pt"),

      plot.margin        = margin(t = 8, r = 12, b = 8, l = 8)
    )

  print(p_sankey)

} else {
  message("Thiếu df_cleaned hoặc thiếu cột issue_d / Default. Bỏ qua Sankey plot.")
}

Vì dữ liệu gốc thiếu thông tin theo dõi hàng tháng, code này mô phỏng dữ liệu để tạo biểu đồ Sankey.

• Ta thiết lập các quy tắc chuyển đổi.
  • Ta định nghĩa hai bộ quy tắc (ma trận chuyển trạng thái): một cho khách hàng “tốt” và một cho khách hàng “xấu”.
  • Mỗi quy tắc xác định xác suất một khoản vay chuyển từ trạng thái này sang trạng thái khác trong tháng tiếp theo (ví dụ: từ 30 DPD về Current).
• Ta mô phỏng dữ liệu.
  • Code tạo ra một chuỗi trạng thái hàng tháng cho mỗi khoản vay dựa trên các quy tắc Ta đã đặt ra.
• Ta vẽ biểu đồ Sankey.
  • Code đếm số lượng các “dòng chảy” giữa các trạng thái và dùng gói ggalluvial để vẽ chúng.

Biểu đồ Sankey cho Ta thấy sự di chuyển của các khoản vay giữa các trạng thái nợ xấu từ tháng này sang tháng sau. Độ dày của dòng chảy cho biết số lượng.

• Ta thấy các dòng chảy “tự phục hồi”.
  • Đây là các dòng chảy từ 30 DPD hoặc 60 DPD đi ngược lên Current.
  • Nó cho thấy các khách hàng đã khắc phục được tình trạng trễ hạn.
• Ta thấy các dòng chảy “leo thang rủi ro”.
  • Đây là các dòng chảy đi xuống, ví dụ từ 30 DPD sang 60 DPD.
• Ta thấy dòng chảy “vỡ nợ”.
  • Dòng chảy từ 90 DPD sang Defaulted rất lớn. Điều này cho thấy khi một khoản vay trễ 90 ngày, khả năng vỡ nợ là rất cao.
• Trạng thái 30 DPD là một ngã ba quan trọng.
  • Từ đây, các khoản vay có thể phục hồi hoặc tiếp tục xấu đi. Đây là điểm quan trọng để can thiệp thu hồi nợ.

3.16 Đường cong Kolmogorov-Smirnov

need <- c("Default","fico_n","dti_n","lti")
if (all(need %in% names(df_cleaned))) {

  # ----- Palette tươi & dễ phân biệt -----
  col_bad   <- "#E74C3C"   # đỏ cam
  col_good  <- "#2E86DE"   # xanh lam
  col_ks    <- "#2C3E50"   # xanh đen
  grid_band <- "#F7F9FC"   # nền nhạt cho band

  # ----- Chuẩn bị dữ liệu & xếp hạng theo score s -----
  dat <- df_cleaned %>%
    transmute(
      y = as.integer(Default),
      s = as.numeric(scale(-fico_n) + scale(dti_n) + scale(lti))
    ) %>%
    filter(is.finite(y), is.finite(s)) %>%
    arrange(desc(s))

  nbad <- sum(dat$y == 1)
  ngood <- sum(dat$y == 0)

  dat <- dat %>%
    mutate(
      pct       = row_number()/n(),
      cum_bad   = cumsum(y == 1)/pmax(nbad, 1),
      cum_good  = cumsum(y == 0)/pmax(ngood, 1),
      ks        = abs(cum_bad - cum_good)
    )

  ks_idx <- which.max(dat$ks)
  ksp    <- dat[ks_idx, , drop = FALSE]
  ks_val <- ksp$ks

  # ----- Vẽ -----
  ggplot(dat, aes(x = pct)) +
    # nền band nhẹ để tăng độ tương phản
    annotate("rect", xmin = 0, xmax = 1, ymin = 0, ymax = 1, fill = grid_band, alpha = 0.7) +

    # hai đường tích lũy
    geom_line(aes(y = cum_bad, color = "Bad (Default)"), linewidth = 1.4, lineend = "round") +
    geom_line(aes(y = cum_good, color = "Good (Non-default)"), linewidth = 1.4, lineend = "round") +

    # đoạn thẳng thể hiện KS lớn nhất
    geom_segment(
      data = ksp,
      aes(x = pct, xend = pct, y = cum_good, yend = cum_bad),
      color = col_ks, linewidth = 1.2, lineend = "round"
    ) +

    # điểm & nhãn tại vị trí KS max
    geom_point(data = ksp, aes(y = cum_bad), color = col_bad, size = 2.8, stroke = 0) +
    geom_point(data = ksp, aes(y = cum_good), color = col_good, size = 2.8, stroke = 0) +
    annotate(
      "label",
      x = ksp$pct + 0.04, y = (ksp$cum_bad + ksp$cum_good)/2,
      label = paste0("KS = ", percent(ks_val, accuracy = 0.1), "\nTại ", percent(ksp$pct, accuracy = 0.1), " dân số"),
      hjust = 0, vjust = 0.5, label.size = 0.2, size = 3.6,
      fill = "white", color = col_ks
    ) +

    # trục & nhãn
    scale_x_continuous(labels = label_percent(accuracy = 10), expand = expansion(mult = c(0.01, 0.06))) +
    scale_y_continuous(labels = label_percent(accuracy = 5), limits = c(0, 1), expand = expansion(mult = c(0, 0.02))) +

    # màu legend
    scale_color_manual(
      NULL,
      values = c("Bad (Default)" = col_bad, "Good (Non-default)" = col_good)
    ) +

    labs(
      title    = paste0("KS Curve — ", percent(ks_val, accuracy = 0.1)),
      subtitle = "So sánh tích lũy Bad vs. Good theo percentile của điểm rủi ro (s)",
      x = "Tỷ trọng dân số tích lũy",
      y = "Tỷ trọng tích lũy",
      caption  = "Ghi chú: KS = max|CumBad - CumGood|. Điểm rủi ro s = -scale(FICO) + scale(DTI) + scale(LTI)"
    ) +

    # theme hiện đại
    theme_minimal(base_size = 12) +
    theme(
      plot.title      = element_text(face = "bold", size = 14),
      plot.subtitle   = element_text(color = "#34495E"),
      axis.title.x    = element_text(margin = margin(t = 6)),
      axis.title.y    = element_text(margin = margin(r = 6)),
      panel.grid.minor= element_blank(),
      panel.grid.major.x = element_blank(),
      legend.position = "top",
      legend.box      = "horizontal",
      legend.text     = element_text(size = 10),
      plot.caption    = element_text(color = "#7F8C8D", size = 9)
    )

} else {
  message("Cần các cột: Default, fico_n, dti_n, lti trong df_cleaned.")
}

Code này tạo ra đường cong KS để đo lường khả năng phân biệt khách hàng tốt và xấu của mô hình điểm rủi ro.

• Tạo một điểm rủi ro s bằng cách kết hợp FICO, DTI, và LTI.
• Sắp xếp toàn bộ dữ liệu theo điểm rủi ro này, từ cao nhất đến thấp nhất.
• Tính toán và vẽ hai đường cong: tỷ lệ khách hàng xấu tích lũy (đỏ) và tỷ lệ khách hàng tốt tích lũy (xanh).
• Khoảng cách lớn nhất giữa hai đường cong này chính là chỉ số KS. Biểu đồ làm nổi bật điểm này.

Đường cong KS để đo lường khả năng phân biệt khách hàng tốt và xấu của mô hình điểm rủi ro

• Chỉ số KS của mô hình là 21.0%.
  • Giá trị này cho thấy mô hình có sức mạnh phân biệt ở mức chấp nhận được, nhưng không quá mạnh.
• Đường cong đỏ (Xấu) nằm trên đường cong xanh (Tốt).
  • Điều này cho thấy mô hình đang hoạt động đúng. Nó xếp hạng khách hàng xấu ở nhóm rủi ro cao hơn.
• Khoảng cách lớn nhất (21.0%) xảy ra tại 45.1% dân số rủi ro nhất.
  • Tại điểm này, Ta đã bắt được 63% khách hàng xấu và chỉ bắt nhầm 42% khách hàng tốt.

3.17 Bản đồ nhiệt rủi ro vỡ nợ theo bang

if (all(c("addr_state","Default") %in% names(df_cleaned))) {

  # Bảng tham chiếu viết tắt bang -> tên bang thường (lower)
  state_ref <- data.frame(
    abbr = state.abb, name = tolower(state.name), stringsAsFactors = FALSE
  )

  # Tính tỷ lệ default theo bang
  agg <- df_cleaned %>%
    filter(!is.na(addr_state)) %>%
    mutate(abbr = toupper(as.character(addr_state))) %>%
    inner_join(state_ref, by = "abbr") %>%
    group_by(name) %>%
    summarise(n = n(),
              rate = sum(Default == 1, na.rm = TRUE) / n(),
              .groups = "drop")

  # Dữ liệu bản đồ (polygon)
  us_map  <- ggplot2::map_data("state") %>% as_tibble()
  plot_df <- left_join(us_map, agg, by = c("region" = "name"))

  # Tâm bang để đặt nhãn (dùng built-in state.center)
  centers <- tibble(
    region = tolower(state.name),
    cx = state.center$x,
    cy = state.center$y
  ) %>% left_join(agg, by = c("region" = "name"))

  # Vẽ
  p <- ggplot(plot_df, aes(long, lat, group = group, fill = rate)) +
    geom_polygon(color = "white", linewidth = 0.25) +
    coord_fixed(1.28) +
    scale_fill_viridis_c(option = "C", direction = -1,
                         labels = percent, na.value = "#EFEFEF") +
    labs(
      title = "Tỷ lệ vỡ nợ theo bang (USA)",
      fill = "Default (%)"
    ) +
    theme_void(base_size = 12) +
    theme(
      plot.title = element_text(face = "bold", size = 14),
      plot.subtitle = element_text(color = "#555555"),
      legend.title = element_text(face = "bold"),
      panel.background = element_rect(fill = "#F8F9FB", colour = NA)
    )

  p +
    geom_text(
      data = centers,
      inherit.aes = FALSE,
      aes(x = cx, y = cy,
          label = ifelse(is.na(rate), str_to_title(region),
                         paste0(str_to_title(region), "\n", scales::percent(rate, 0.1)))),
      size = 1.4, lineheight = 0.7, color = "#2C3E50", fontface = "bold"
    )

} else {
  message("Cần cột addr_state & Default trong df_cleaned.")
}

Code này tạo ra một bản đồ nhiệt của Hoa Kỳ để trực quan hóa tỷ lệ vỡ nợ theo từng bang.

• Tính toán tỷ lệ vỡ nợ cho mỗi bang.
• Lấy dữ liệu tọa độ bản đồ Hoa Kỳ.
• Kết hợp hai bộ dữ liệu này lại với nhau.
• Dùng ggplot2 và geom_polygon để vẽ bản đồ, trong đó màu sắc của mỗi bang thể hiện tỷ lệ vỡ nợ của bang đó.

Kết quả:

• Rủi ro vỡ nợ không đồng đều trên cả nước.
  • Có những cụm địa lý rõ rệt về rủi ro.
• Ta thấy một “vành đai rủi ro cao”.
  • Một dải các bang ở miền Nam và Trung Tây có tỷ lệ vỡ nợ cao hơn, ví dụ như Mississippi (26.1%) và Nebraska (25.2%).
• Ta thấy các “vùng an toàn”.
  • Các bang ở Đông Bắc (như Maine, Vermont) và Tây Bắc (như Oregon) có tỷ lệ vỡ nợ thấp hơn đáng kể.
• Các bang lớn có mức rủi ro khác nhau.
  • California và Texas có tỷ lệ vỡ nợ gần mức trung bình.
  • New York và Florida có tỷ lệ cao hơn một chút.

3.18 Phân phối có điều kiện

palette_variant <- "BlueRose"

get_palette <- function(n, variant = "OkabeIto") {
  base <- switch(variant,
    "BlueRose"  = c("#BFC4E3","#F3E5A3","#C9EAC8","#C9A1C9","#B97EA1","#A64D79","#6D597A","#355070")
  )
  if (n <= length(base)) base[seq_len(n)] else rep(base, length.out = n)
}

need <- c("loan_amnt","fico_group")
if (all(need %in% names(df_cleaned))) {
  dfp <- df_cleaned %>%
    filter(is.finite(loan_amnt)) %>%
    mutate(fico_group = forcats::fct_explicit_na(fico_group, "Missing"))

  # Sắp xếp nhóm theo median để dễ so sánh
  dfp$fico_group <- forcats::fct_reorder(dfp$fico_group, dfp$loan_amnt, median, .na_rm = TRUE)

  # Lấy palette theo số nhóm thực tế
  pal <- get_palette(n = nlevels(dfp$fico_group), variant = palette_variant)

  # Lấy mẫu điểm nhẹ để rải
  set.seed(9)
  pts <- dplyr::slice_sample(dfp, n = min(4000, nrow(dfp)))

  # Giới hạn 98th percentile để tránh outlier kéo scale
  y_cap <- quantile(dfp$loan_amnt, 0.98, na.rm = TRUE)

  ggplot(dfp, aes(x = fico_group, y = pmin(loan_amnt, y_cap), fill = fico_group)) +
    geom_violin(width = 0.9, trim = TRUE, alpha = 0.95,
                color = NA, draw_quantiles = c(0.25, 0.5, 0.75)) +
    geom_boxplot(width = 0.14, outlier.shape = 16, outlier.alpha = 0.10,
                 fill = "white", color = "#2E3440", linewidth = 0.35) +
    geom_point(data = pts, inherit.aes = FALSE,
               aes(x = fico_group, y = pmin(loan_amnt, y_cap)),
               position = position_jitter(width = 0.15, height = 0, seed = 9),
               size = 0.55, alpha = 0.15) +
    scale_fill_manual(values = pal) +
    scale_y_continuous(labels = dollar_format(accuracy = 1),
                       expand = expansion(mult = c(0.03, 0.08))) +
    coord_flip() +
    labs(
      title = "Loan Amount theo FICO Group",
      subtitle = paste0("Bảng màu: ", palette_variant, " • Violin (25–50–75%) + Boxplot • Sắp xếp theo median"),
      x = NULL, y = "Loan amount (USD)",
      caption = "Trục Y cắt tại 98th percentile để tăng độ đọc."
    ) +
    guides(fill = "none") +
    theme_minimal(base_size = 12) +
    theme(
      plot.title = element_text(face = "bold", size = 14),
      plot.subtitle = element_text(color = "#555555"),
      panel.grid.minor = element_blank(),
      panel.grid.major.y = element_blank(),
      panel.background = element_rect(fill = "#FAFAFA", colour = NA),
      plot.background = element_rect(fill = "white", colour = NA),
      axis.text.y = element_text(face = "bold")
    )
} else {
  message("Cần loan_amnt & fico_group.")
}

Code này tạo ra một biểu đồ kết hợp Violin và Boxplot để so sánh sự phân bổ của số tiền vay giữa các nhóm FICO khác nhau.

• Sắp xếp các nhóm FICO dựa trên giá trị trung vị của số tiền vay.
• Giới hạn trục Y để loại bỏ ảnh hưởng của các giá trị ngoại lai, giúp biểu đồ dễ đọc hơn.
• Biểu đồ sử dụng ba lớp:
  • Violin plot: Cho thấy hình dạng phân phối của số tiền vay.
  • Boxplot: Cung cấp tóm tắt thống kê chính xác (trung vị, tứ phân vị).
  • Jitter plot: Hiển thị một mẫu các điểm dữ liệu thô.

Kết quả:

• Có mối quan hệ đồng biến giữa chất lượng tín dụng và số tiền vay.
  • Khi nhóm FICO cải thiện, số tiền vay trung vị cũng có xu hướng tăng lên.
• Các nhóm Fair và Good có số tiền vay trung vị thấp hơn.
  • Cả hai nhóm này có số tiền vay trung vị khoảng $10,000-$12,000.
• Các nhóm Very Good và Exceptional vay số tiền lớn hơn.
  • Đặc biệt, nhóm Very Good có số tiền vay trung vị cao nhất.
• Phân bổ số tiền vay có nhiều đỉnh.
  • Hình dạng “violin” cho thấy các khoản vay thường tập trung ở các mốc số tiền chẵn (ví dụ: $10k, $20k).
• Có một điểm bất thường trong thứ tự.
  • Nhóm Very Good vay số tiền trung vị cao hơn nhóm Exceptional. Điều này đặt ra một câu hỏi thú vị để Ta tiếp tục khám phá.

3.19 Cơ cấu dịch chuyển của danh mục

palette_variant <- "SandNavy"

get_palette <- function(n, variant = "OkabeIto") {
  base <- switch(variant,
    "SandNavy"  = c("#F4E6C1","#E7D4A8","#D4B483","#A3B1C6",
                    "#7C90A0","#5B6C7F","#3E4C66","#2A3650") )
  if (n <= length(base)) base[seq_len(n)] else rep(base, length.out = n)
}

need <- c("issue_d","purpose")
if (all(need %in% names(df_cleaned))) {

  # Chuẩn hoá mốc quý (ngày đầu quý) để vẽ trục X theo thời gian đẹp, đều
  df_q <- df_cleaned %>%
    filter(!is.na(issue_d)) %>%
    mutate(q_date = floor_date(issue_d, unit = "quarter"),
           purpose_top = forcats::fct_lump_n(purpose, n = 8, other_level = "Other"))

  # Dải quý đầy đủ (fill zero) để area không bị hở
  all_q  <- tibble(q_date = seq(min(df_q$q_date, na.rm=TRUE),
                                max(df_q$q_date, na.rm=TRUE),
                                by = "quarter"))
  all_p  <- tibble(purpose_top = levels(df_q$purpose_top))
  base_grid <- tidyr::crossing(all_q, all_p)

  # Đếm & chuẩn hoá thành tỷ trọng theo quý
  dat <- df_q %>%
    count(q_date, purpose_top, name = "n") %>%
    right_join(base_grid, by = c("q_date","purpose_top")) %>%
    mutate(n = replace_na(n, 0L)) %>%
    group_by(q_date) %>%
    mutate(share = if (sum(n) > 0) n / sum(n) else 0) %>%
    ungroup()

  # Sắp xếp legend theo tỷ trọng trung bình (nhóm quan trọng lên trước)
  purpose_order <- dat %>%
    group_by(purpose_top) %>% summarise(avg_share = mean(share), .groups="drop") %>%
    arrange(desc(avg_share)) %>% pull(purpose_top)
  dat <- dat %>% mutate(purpose_top = factor(purpose_top, levels = purpose_order))

  # Palette theo số levels thực tế
  pal <- get_palette(n = nlevels(dat$purpose_top), variant = palette_variant)

  # Nhãn quý "YYYY-Qx"
  q_label <- function(d) {
    y <- year(d); q <- quarter(d)
    paste0(y,"-Q",q)
  }

  ggplot(dat, aes(x = q_date, y = share, fill = purpose_top)) +
    geom_area(position = "stack", alpha = 0.96, linewidth = 0.1, color = NA) +
    scale_y_continuous(labels = percent_format(accuracy = 1),
                       expand = expansion(mult = c(0, 0.02))) +
    scale_x_date(breaks = scales::breaks_pretty(n = 10),
                 labels = q_label, expand = expansion(mult = c(0.01, 0.02))) +
    scale_fill_manual(values = pal, name = "Purpose") +
    labs(
      title = "Cơ cấu mục đích vay theo thời gian (theo quý)",
      x = NULL, y = "Tỷ trọng",
      caption = "Lấp đầy quý thiếu bằng 0 để đường khu vực liền mạch
  ; legend sắp theo tỷ trọng trung bình."
    ) +
    theme_minimal(base_size = 12) +
    theme(
      plot.title = element_text(face = "bold", size = 14),
      plot.subtitle = element_text(color = "#555555"),
      panel.grid.minor = element_blank(),
      panel.grid.major.x = element_line(linewidth = 0.25),
      panel.grid.major.y = element_line(linewidth = 0.25),
      legend.position = "right",
      legend.title = element_text(face = "bold"),
      plot.background = element_rect(fill = "white", colour = NA),
      panel.background = element_rect(fill = "#FAFAFA", colour = NA),
      axis.text.x = element_text(angle = 30, hjust = 1)
    )
} else {
  message("Cần issue_d & purpose.")
}

Code này tạo ra một biểu đồ vùng xếp chồng để thấy cơ cấu mục đích vay đã thay đổi như thế nào theo thời gian.

• Tổng hợp dữ liệu theo quý và gom các mục đích vay ít phổ biến vào nhóm “Other”.
• Tạo một lưới thời gian hoàn chỉnh để đảm bảo không có khoảng trống trong dữ liệu, giúp biểu đồ liền mạch.
• Tính toán tỷ trọng của mỗi mục đích vay trong từng quý.
• Sắp xếp chú giải của biểu đồ dựa trên tỷ trọng trung bình, giúp các mục đích quan trọng nhất dễ nhận biết hơn.
• Dùng ggplot2 và geom_area để vẽ biểu đồ.

Kết quả:

• Hợp nhất nợ (debt_consolidation) luôn chiếm tỷ trọng lớn nhất.
  • Tỷ trọng của nó rất cao trong giai đoạn 2008-2012, sau đó ổn định ở mức 50-60%.
• Trả nợ thẻ tín dụng (credit_card) có xu hướng tăng trưởng.
  • Nó trở thành mục đích vay lớn thứ hai trong giai đoạn 2014-2018.
• Các mục đích rủi ro hơn đã suy giảm.
  • Các mục đích như vay kinh doanh nhỏ (small_business) chiếm tỷ trọng đáng kể trong giai đoạn đầu nhưng đã giảm đi rất nhiều sau đó.
• Biểu đồ cho thấy sự thay đổi trong chiến lược kinh doanh.
  • Danh mục đã chuyển từ đa dạng trong giai đoạn đầu sang tập trung vào hai sản phẩm cốt lõi là hợp nhất nợ và trả nợ thẻ tín dụng

3.20 Phân tích rủi ro Fico-DTI

palette_variant <- "ViridisC"
get_scale <- function(variant = "ViridisC") {
  switch(variant,
    "ViridisC" = scale_fill_viridis_c(option = "C", direction = -1,
                                      labels = percent_format(accuracy = 1),
                                      name = "Default%"),
    "Magma"    = scale_fill_viridis_c(option = "A", direction = -1,
                                      labels = percent_format(accuracy = 1),
                                      name = "Default%"),
    "Plasma"   = scale_fill_viridis_c(option = "B", direction = -1,
                                      labels = percent_format(accuracy = 1),
                                      name = "Default%"),
    "Cividis"  = scale_fill_viridis_c(option = "E", direction = -1,
                                      labels = percent_format(accuracy = 1),
                                      name = "Default%"),
    scale_fill_viridis_c(labels = percent_format(accuracy = 1), name = "Default%")
  )
}

need <- c(".y")
if (!is.null(df_base)) {
  xcol <- if ("fico_n" %in% names(df_base)) "fico_n" else if ("fico" %in% names(
df_base)) "fico" else NA
  ycol <- if ("dti_n"  %in% names(df_base)) "dti_n"  else if ("dti"  %in% names(
df_base)) "dti"  else NA

  if (is.character(xcol) && is.character(ycol) && all(need %in% names(df_base))) {

    d <- df_base %>%
      filter(is.finite(.data[[xcol]]), is.finite(.data[[ycol]]), !is.na(.y)) %>%
      mutate(.x = .data[[xcol]], .yvar = .data[[ycol]])

    if (nrow(d) > 500) {
      bins_target <- pmin(80L, pmax(40L, as.integer(sqrt(nrow(d))/2)))
      med_x <- median(d$.x, na.rm = TRUE)
      med_y <- median(d$.yvar, na.rm = TRUE)

      # tính trước kích thước mẫu cho lớp điểm mờ
      sample_n <- min(2000L, nrow(d))
      d_sample <- if (sample_n < nrow(d)) d %>% slice_sample(n = sample_n) else d

      p <- ggplot(d, aes(x = .x, y = .yvar)) +
        stat_summary_2d(aes(z = .y), fun = mean, bins = bins_target) +
        geom_vline(xintercept = med_x, linewidth = 0.25, linetype = "dashed", color = "#2C3E50") +
        geom_hline(yintercept = med_y, linewidth = 0.25, linetype = "dashed", color = "#2C3E50") +
        geom_point(data = d_sample, aes(x = .x, y = .yvar),
                   size = 0.3, alpha = 0.15, inherit.aes = FALSE) +
        get_scale(palette_variant) +
        scale_x_continuous(expand = expansion(mult = c(0.02, 0.02))) +
        scale_y_continuous(expand = expansion(mult = c(0.02, 0.02))) +
        guides(fill = guide_colorbar(barheight = unit(60, "pt"), ticks = TRUE)) +
        labs(
          title = "Risk Surface — Mean(Default) theo (FICO × DTI)",
          subtitle = paste0("Binned heatmap (", bins_target, 
          "×", bins_target, ") • Bảng màu: ", palette_variant),
          x = if (!is.na(xcol)) xcol else "fico",
          y = if (!is.na(ycol)) ycol else "dti",
          caption = "Đường đứt: median mỗi trục • Lớp điểm mờ: mẫu để gợi ý mật độ"
        ) +
        theme_minimal(base_size = 12) +
        theme(
          plot.title = element_text(face = "bold", size = 14),
          plot.subtitle = element_text(color = "#555555"),
          panel.grid.minor = element_blank(),
          panel.grid.major = element_line(linewidth = 0.25),
          legend.position = "right",
          legend.title = element_text(face = "bold"),
          plot.background = element_rect(fill = "white", colour = NA),
          panel.background = element_rect(fill = "#FAFAFA", colour = NA)
        )

      if (exists(".silent_plot")) .silent_plot(p) else print(p)
    } else {
      message("Cần tối thiểu >500 quan sát để heatmap mịn. Hiện n = ", nrow(d), ".")
    }
  }
}

Code này tạo ra một bản đồ nhiệt hai chiều để thấy được tỷ lệ vỡ nợ thay đổi theo sự kết hợp của FICO và DTI.

• Tạo bản đồ nhiệt
  • Dùng stat_summary_2d. Nó chia không gian thành một lưới ô vuông.
  • Màu sắc của mỗi ô được quyết định bởi tỷ lệ vỡ nợ trung bình của các khách hàng trong ô đó.
• Thêm ngữ cảnh
  • Vẽ các đường chấm chấm tại giá trị trung vị của FICO và DTI.
  • Thêm một lớp các điểm dữ liệu mờ để cho thấy dữ liệu tập trung ở đâu, giúp Ta đánh giá độ tin cậy của các vùng rủi ro.

Kết quả:

• Điểm FICO có ảnh hưởng lớn đến rủi ro.
  • Khi di chuyển từ trái sang phải (FICO tăng), màu sắc chuyển từ tím/đỏ (rủi ro cao) sang vàng (rủi ro thấp).
• Ta phát hiện ra một hiệu ứng tương tác quan trọng.
  • Ở mức FICO thấp (dưới 700), DTI là một yếu tố rủi ro quan trọng. Những người có DTI cao ở nhóm này có rủi ro rất cao.
  • Ở mức FICO cao (trên 750), gần như tất cả các ô đều có màu vàng, bất kể DTI. Điều này cho thấy DTI ít ảnh hưởng đến rủi ro ở nhóm khách hàng có FICO cao.
• Ta xác định được vùng rủi ro cao nhất.
  • Góc dưới bên trái (FICO thấp, DTI thấp) là điểm nóng rủi ro, với màu tím và đỏ đậm tập trung nhiều nhất.

3.21 Bản đồ nhiệt rủi ro theo thời gian

palette_variant <- "ViridisC"  # "ViridisC" | "Plasma" | "Magma" | "Cividis"

get_fill_scale <- function(variant = "ViridisC") {
  switch(variant,
    "Plasma"  = scale_fill_viridis_c(option = "B", direction = -1,
                                     labels = percent_format(accuracy = 1),
                                     name = "Default%"),
    "Magma"   = scale_fill_viridis_c(option = "A", direction = -1,
                                     labels = percent_format(accuracy = 1),
                                     name = "Default%"),
    "Cividis" = scale_fill_viridis_c(option = "E", direction = -1,
                                     labels = percent_format(accuracy = 1),
                                     name = "Default%"),
    # Mặc định:
    scale_fill_viridis_c(option = "C", direction = -1,
                         labels = percent_format(accuracy = 1),
                         name = "Default%")
  )
}

if (!is.null(df_base)) {
  tcol <- if ("issue_d" %in% names(df_base)) "issue_d"
          else if ("origination_date" %in% names(df_base)) "origination_date"
          else NA

  if (is.character(tcol) &&
      (inherits(df_base[[tcol]], "Date") ||
       inherits(df_base[[tcol]], "POSIXt") ||
       is.character(df_base[[tcol]]))) {

    d <- df_base

    # Chuẩn hoá ngày: thử ISO, nếu không thì đoán định dạng thông dụng
    if (is.character(d[[tcol]])) {
      suppressWarnings({
        d[[tcol]] <- as.Date(d[[tcol]])
        if (all(is.na(d[[tcol]]))) d[[tcol]] <- lubridate::ymd(df_base[[tcol]], quiet = TRUE)
        if (all(is.na(d[[tcol]]))) d[[tcol]] <- lubridate::mdy(df_base[[tcol]], quiet = TRUE)
      })
    }

    d <- d %>%
      filter(!is.na(.y), !is.na(.data[[tcol]])) %>%
      mutate(
        yr  = year(.data[[tcol]]),
        mon = month(.data[[tcol]])
      ) %>%
      group_by(yr, mon) %>%
      summarise(
        n   = n(),
        def = mean(.y == 1, na.rm = TRUE),
        .groups = "drop"
      )

    if (nrow(d) > 0) {
      # Hoàn thiện lưới (đủ 12 tháng mỗi năm) để hiển thị khoảng trống
      yr_range <- range(d$yr, na.rm = TRUE)
      grid <- tidyr::expand_grid(yr = seq(yr_range[1], yr_range[2]), mon = 1:12)
      d2 <- grid %>%
        left_join(d, by = c("yr","mon")) %>%
        mutate(
          mon_f  = factor(mon, levels = 1:12, labels = month.abb),
          # Nhãn % chỉ hiển thị khi có dữ liệu và n đủ lớn
          label  = ifelse(is.finite(def) & !is.na(n) & n >= 30,
                          percent(def, accuracy = 1),
                          ""),
          # Màu chữ 
          txtcol = ifelse(!is.na(def) & def >= 0.25, "#F7F7F7", "#2D313A")
        )
      # Sắp năm theo giảm dần (năm mới ở trên)
      d2$yr_f <- factor(d2$yr, levels = sort(unique(d2$yr), decreasing = TRUE))
      # Thống kê phụ để chèn vào tiêu đề/phụ đề
      N_total <- sum(d2$n %||% 0, na.rm = TRUE)
      date_span <- paste0(min(d$yr), "–", max(d$yr))

      p <- ggplot(d2, aes(x = mon_f, y = yr_f)) +
        geom_tile(aes(fill = def), color = "white", linewidth = 0.35, na.rm = FALSE) +
        # Viền nhẹ cho cả panel
        geom_rect(aes(xmin = 0.5, xmax = 12.5, ymin = 0.5, ymax = length(levels(yr_f)) + 0.5),
                  inherit.aes = FALSE, color = "#E5E7EB", linewidth = 0.4, fill = NA) +
        # Nhãn %
        geom_text(aes(label = label, color = after_stat(NULL)), size = 3, show.legend = FALSE) +
        scale_color_identity() +
        get_fill_scale(palette_variant) +
        scale_x_discrete(expand = c(0, 0)) +
        scale_y_discrete(expand = c(0, 0)) +
        guides(fill = guide_colorbar(barheight = unit(70, "pt"),
                                     ticks = TRUE, frame.colour = "#DDDDDD")) +
        labs(
          title    = "Calendar Heatmap — Tỷ lệ Default theo Năm × Tháng phát hành",
          subtitle = paste0("Khoảng thời gian: ", date_span,
                            " • Tổng bản ghi: ", scales::comma(N_total),
                            " • Nhãn hiển thị khi n ≥ 30"),
          x = "Tháng", y = "Năm"
        ) +
        theme_minimal(base_size = 12) +
        theme(
          plot.title      = element_text(face = "bold", size = 14),
          plot.subtitle   = element_text(color = "#5B6472"),
          panel.grid      = element_blank(),
          axis.title.x    = element_text(margin = margin(t = 6)),
          axis.title.y    = element_text(margin = margin(r = 6)),
          axis.text.x     = element_text(size = 9),
          axis.text.y     = element_text(size = 9),
          legend.position = "right",
          legend.title    = element_text(face = "bold"),
          plot.background = element_rect(fill = "white", colour = NA),
          panel.background= element_rect(fill = "#FAFAFA", colour = NA)
        )

      p <- p + geom_text(data = d2, aes(label = label), color = d2$txtcol, size = 3, na.rm = TRUE)

      if (exists(".silent_plot")) .silent_plot(p) else print(p)
    }
  }
}

Code này tạo ra một bản đồ nhiệt dạng lịch để Ta thấy tỷ lệ vỡ nợ thay đổi như thế nào theo năm và tháng phát hành khoản vay.

• Tổng hợp dữ liệu, tính toán tỷ lệ vỡ nợ cho mỗi Tháng-Năm.
• Tạo một lưới thời gian hoàn chỉnh để xử lý các tháng không có dữ liệu.
• Ta chỉ hiển thị nhãn phần trăm nếu số lượng quan sát đủ lớn (>=30) để đảm bảo độ tin cậy.
• Màu chữ của nhãn tự động thay đổi (trắng hoặc đen) để có độ tương phản tốt nhất với màu nền.
• Dùng ggplot2 và geom_tile để vẽ bản đồ nhiệt.

Kết quả:

• Ta thấy được ảnh hưởng của chu kỳ kinh tế.
  • Giai đoạn khủng hoảng (2007-2008): Tỷ lệ vỡ nợ rất cao (25-32%), thể hiện qua các ô màu tím đậm.
  • Giai đoạn phục hồi (2009-2011): Tỷ lệ vỡ nợ giảm đáng kể, màu sắc chuyển sang cam/đỏ nhạt.
  • Giai đoạn “bình thường mới” (2012-2017): Tỷ lệ vỡ nợ có xu hướng tăng dần trở lại, đỉnh điểm vào 2016-2017.
• Ta có thể tìm kiếm các hiệu ứng mùa vụ.
  • Không có mẫu hình mùa vụ rất rõ ràng, nhưng dường như các tháng cuối năm thường có tỷ lệ vỡ nợ thấp hơn.
• Ta nhận ra vấn đề của dữ liệu mới.
  • Năm 2018 có tỷ lệ vỡ nợ thấp một cách giả tạo.
  • Lý do là các khoản vay này còn quá mới, chưa có đủ thời gian để thể hiện hành vi vỡ nợ.

3.22 Thứ hạng Decile rủi ro

palette_variant <- "ViridisC" # "ViridisC" | "Plasma" | "Magma" | "Cividis"
get_color_scale <- function(variant = "ViridisC") {
  switch(variant,
    "Plasma"  = scale_color_viridis_d(option = "B", direction = -1, name = "Decile"),
    "Magma"   = scale_color_viridis_d(option = "A", direction = -1, name = "Decile"),
    "Cividis" = scale_color_viridis_d(option = "E", direction = -1, name = "Decile"),
    scale_color_viridis_d(option = "C", direction = -1, name = "Decile")
  )
}

if (!is.null(df_base) && any(is.finite(df_base$.p_hat)) && any(!is.na(df_base$.y))) {
  tcol <- if ("issue_d" %in% names(df_base)) "issue_d"
          else if ("origination_date" %in% names(df_base)) "origination_date"
          else NA

  if (is.character(tcol)) {
    d <- df_base
    if (is.character(d[[tcol]])) suppressWarnings(d[[tcol]] <- as.Date(d[[tcol]]))

    d <- d %>%
      filter(is.finite(.p_hat), !is.na(.y), !is.na(.data[[tcol]])) %>%
      mutate(yr = lubridate::year(.data[[tcol]]))

    if (nrow(d) > 0) {
      d2 <- d %>%
        group_by(yr) %>%
        mutate(dec = ntile(.p_hat, 10)) %>%
        ungroup() %>%
        group_by(yr, dec) %>%
        summarise(def = mean(.y == 1), .groups = "drop") %>%
        group_by(yr) %>%
        mutate(rank = rank(-def, ties.method = "first")) %>%
        ungroup() %>%
        mutate(dec = factor(dec),
               highlight = dec %in% c("1","10"))

      yrs <- sort(unique(d2$yr))
      if (length(yrs) >= 1) {
        # Tạo dữ liệu nhãn, cố định x ngoài mép và đặt y = rank
        x_left  <- min(yrs) - 0.25
        x_right <- max(yrs) + 0.25
        lab_left  <- d2 %>% filter(yr == min(yrs)) %>% mutate(x = x_left)
        lab_right <- d2 %>% filter(yr == max(yrs)) %>% mutate(x = x_right)

        p <- ggplot(d2, aes(x = yr, y = rank, group = dec, color = dec)) +
          geom_line(linewidth = 0.9, alpha = 0.65) +
          geom_line(data = d2 %>% filter(highlight), linewidth = 1.6, alpha = 0.95) +
          geom_point(data = d2 %>% filter(highlight), size = 2.6, alpha = 0.95) +

          # Nhãn bên trái (kéo dọc, tránh đè)
          geom_text_repel(
            data = lab_left,
            aes(x = x, y = rank, label = paste0("D", dec), color = dec),
            direction = "y", hjust = 1, nudge_x = -0.02,
            size = 3.2, fontface = "bold",
            box.padding = 0.2, point.padding = 0.2, segment.size = 0.3,
            min.segment.length = 0, seed = 123, inherit.aes = FALSE, show.legend = FALSE
          ) +
          # Nhãn bên phải
          geom_text_repel(
            data = lab_right,
            aes(x = x, y = rank, label = paste0("D", dec), color = dec),
            direction = "y", hjust = 0, nudge_x = 0.02,
            size = 3.2, fontface = "bold",
            box.padding = 0.2, point.padding = 0.2, segment.size = 0.3,
            min.segment.length = 0, seed = 124, inherit.aes = FALSE, show.legend = FALSE
          ) +

          scale_y_reverse(breaks = 1:10) +
          get_color_scale(palette_variant) +
          scale_x_continuous(
            breaks = yrs,
            limits = c(min(yrs) - 0.5, max(yrs) + 0.5), # thêm biên trống hai đầu
            expand = expansion(mult = c(0, 0))
          ) +
          guides(color = guide_legend(override.aes = list(linewidth = 2))) +
          labs(
            title    = "Bump Chart — Thứ hạng decile rủi ro theo năm",
            subtitle = "Hạng 1 = decile có tỷ lệ default cao nhất",
            x = "Năm", y = "Hạng (1 = rủi ro cao nhất)", color = "Decile"
          ) +
          theme_minimal(base_size = 12) +
          theme(
            plot.title = element_text(face = "bold", size = 14),
            plot.subtitle = element_text(color = "#5B6472"),
            panel.grid.minor = element_blank(),
            panel.grid.major.y = element_line(color = "#E6E8ED", linewidth = 0.5),
            panel.grid.major.x = element_line(color = "#F0F1F5", linewidth = 0.4),
            axis.title.x = element_text(margin = margin(t = 6)),
            axis.title.y = element_text(margin = margin(r = 6)),
            legend.position = "right",
            legend.title = element_text(face = "bold"),
            plot.background = element_rect(fill = "white", colour = NA),
            panel.background = element_rect(fill = "#FAFAFA", colour = NA),
            plot.margin = margin(10, 30, 10, 30) # thêm biên để chứa nhãn ngoài trục
          ) +
          coord_cartesian(clip = "off")  # cho phép vẽ ngoài vùng panel

        if (exists(".silent_plot")) .silent_plot(p) else print(p)
      }
    }
  }
}

Code này tạo ra một biểu đồ Bump Chart” để theo dõi xem thứ hạng rủi ro của các nhóm khách hàng thay đổi như thế nào qua các năm.

• Tạo các nhóm rủi ro.
  • Trong mỗi năm, Ta chia khách hàng thành 10 nhóm (deciles) dựa trên điểm rủi ro .p_hat. Decile 10 là nhóm có điểm rủi ro cao nhất.
• Tính toán rủi ro thực tế.
  • Ta tính tỷ lệ vỡ nợ thực tế cho mỗi nhóm trong mỗi năm.
• Xếp hạng các nhóm.
  • Trong mỗi năm, Ta xếp hạng các nhóm này dựa trên tỷ lệ vỡ nợ. Hạng 1 được gán cho nhóm có tỷ lệ vỡ nợ cao nhất.
• Vẽ biểu đồ.
  • Biểu đồ vẽ các đường nối thứ hạng của mỗi nhóm qua các năm.

Kết quả:

• Mô hình xếp hạng rủi ro của Ta rất ổn định qua thời gian.
  • Điều này được thể hiện qua việc các đường ít giao cắt nhau.
• Nhóm rủi ro cao nhất (D10, màu xanh đậm) luôn có thứ hạng rủi ro thực tế cao nhất.
  • Đường này gần như luôn nằm ở Hạng 1 hoặc 2.
• Nhóm an toàn nhất (D1, màu vàng) luôn có thứ hạng rủi ro thực tế thấp nhất.
  • Đường này luôn nằm ở Hạng 10.
• Sự biến động xảy ra ở các nhóm trung bình.
  • Các đường ở giữa giao cắt nhau nhiều hơn.
  • Điều này có nghĩa là mô hình của Ta phân biệt rất tốt giữa các nhóm khách hàng tốt nhất và xấu nhất, nhưng kém hơn một chút trong việc phân biệt các khách hàng có rủi ro trung bình.

4 Phân tích BCTC CTCP Vàng bạc Đá quý Phú Nhuận (HOSE: PNJ)

---

Bài phân tích của tôi sẽ trình bày một quy trình phân tích định lượng toàn diện về sức khỏe tài chính và hiệu quả hoạt động của Công ty Cổ phần Vàng bạc Đá quý Phú Nhuận (PNJ), một trong những doanh nghiệp đầu ngành bán lẻ trang sức tại Việt Nam.

Mục tiêu cốt lõi là giải mã các động lực tăng trưởng, bóc tách cấu trúc tài chính, và các yếu tố quyết định đến khả năng sinh lời của PNJ trong giai đoạn từ Quý 1 2017 đến nay (Quý 2 2025), dựa trên dữ liệu báo cáo tài chính công bố.

Thông qua việc áp dụng các phương pháp phân tích BCTC, chúng tôi hướng đến việc trả lời các câu hỏi then chốt:

• Xu hướng tăng trưởng của PNJ bền vững đến đâu và được thúc đẩy bởi những yếu tố nào?
• Hiệu quả sử dụng vốn và quản trị vốn lưu động của công ty đã biến đổi ra sao theo thời gian?
• Các quyết định về đòn bẩy tài chính đã tác động như thế nào đến khả năng sinh lời trên vốn chủ sở hữu (ROE)?
• Chất lượng dòng tiền từ hoạt động kinh doanh có tương xứng với lợi nhuận ghi nhận trên sổ sách không?

4.1 Tải dữ liệu thô và kiểm tra tiền phân tích

data_path2 <- if (exists("params") && !is.null(params$data_path2)) params$data_path2 else
  "BCTC_PNJ.xlsx"
if (!file.exists(data_path2)) stop("Không tìm thấy file: ", data_path2)
message("[INFO] Đọc dữ liệu từ: ", data_path2)  # hoặc cat("[INFO] ...\n")
#------

data_path2 <- if (exists("params") && !is.null(params$data_path2)) params$data_path2 else 
  "BCTC_PNJ.xlsx"
#-----
if (!file.exists(data_path2)) stop("Không tìm thấy file: ", data_path2)
df_raw <- readxl::read_excel(path = data_path2, sheet = 1)
dplyr::glimpse(df_raw)

## Rows: 17
## Columns: 35
## $ Indicator <chr> "ta", "equity", "tl", "ca", "cl", "inv_net", "ar", "ap", "re…
## $ `Q1 2017` <dbl> 3.595808e+12, 1.749066e+12, 1.846742e+12, 3.106734e+12, 1.78…
## $ `Q2 2017` <dbl> 3.561007e+12, 1.735442e+12, 1.825565e+12, 3.055472e+12, 1.77…
## $ `Q3 2017` <dbl> 4.063461e+12, 2.728456e+12, 1.335006e+12, 3.480268e+12, 1.31…
## $ `Q4 2017` <dbl> 4.492513e+12, 2.950301e+12, 1.542211e+12, 3.896409e+12, 1.52…
## $ `Q1 2018` <dbl> 4.688396e+12, 3.198904e+12, 1.489493e+12, 3.872677e+12, 1.40…
## $ `Q2 2018` <dbl> 5.173682e+12, 3.366712e+12, 1.806970e+12, 4.233071e+12, 1.74…
## $ `Q3 2018` <dbl> 5.481233e+12, 3.382261e+12, 2.098972e+12, 4.491050e+12, 2.07…
## $ `Q4 2018` <dbl> 6.303185e+12, 3.745313e+12, 2.557872e+12, 5.280216e+12, 2.54…
## $ `Q1 2019` <dbl> 6.152152e+12, 4.040218e+12, 2.111934e+12, 5.065795e+12, 2.09…
## $ `Q2 2019` <dbl> 6.526498e+12, 4.092534e+12, 2.433964e+12, 5.333230e+12, 2.42…
## $ `Q3 2019` <dbl> 7.625552e+12, 4.120300e+12, 3.505252e+12, 6.396513e+12, 3.49…
## $ `Q4 2019` <dbl> 8.600312e+12, 4.574035e+12, 4.026277e+12, 7.330560e+12, 4.01…
## $ `Q1 2020` <dbl> 8.389422e+12, 4.985528e+12, 3.403894e+12, 7.097183e+12, 3.39…
## $ `Q2 2020` <dbl> 8.162334e+12, 4.701173e+12, 3.461161e+12, 6.863106e+12, 3.45…
## $ `Q3 2020` <dbl> 8.091042e+12, 4.903259e+12, 3.187783e+12, 6.786222e+12, 3.17…
## $ `Q4 2020` <dbl> 8.483371e+12, 5.241862e+12, 3.241509e+12, 7.144154e+12, 3.23…
## $ `Q1 2021` <dbl> 8.136212e+12, 5.752949e+12, 2.383263e+12, 6.821148e+12, 2.37…
## $ `Q2 2021` <dbl> 9.175654e+12, 5.718861e+12, 3.456793e+12, 7.870492e+12, 3.44…
## $ `Q3 2021` <dbl> 9168881692481, 5559332736154, 3609548956327, 7887307408212, …
## $ `Q4 2021` <dbl> 1.054664e+13, 6.016510e+12, 4.530132e+12, 9.220118e+12, 4.52…
## $ `Q1 2022` <dbl> 1.141021e+13, 8.008233e+12, 3.401972e+12, 1.009283e+13, 3.32…
## $ `Q2 2022` <dbl> 1.101943e+13, 8.029628e+12, 2.989799e+12, 9.707247e+12, 2.98…
## $ `Q3 2022` <dbl> 1.246321e+13, 8.318218e+12, 4.144991e+12, 1.115783e+13, 4.13…
## $ `Q4 2022` <dbl> 1.332110e+13, 8.587800e+12, 4.733304e+12, 1.195792e+13, 4.72…
## $ `Q1 2023` <dbl> 1.283083e+13, 9.192688e+12, 3.638140e+12, 1.143193e+13, 3.62…
## $ `Q2 2023` <dbl> 1.349285e+13, 9.194055e+12, 4.298800e+12, 1.208256e+13, 4.28…
## $ `Q3 2023` <dbl> 1.305516e+13, 9.436999e+12, 3.618164e+12, 1.161576e+13, 3.60…
## $ `Q4 2023` <dbl> 1.442994e+13, 9.806566e+12, 4.623377e+12, 1.296011e+13, 4.61…
## $ `Q1 2024` <dbl> 1.296893e+13, 1.047438e+13, 2.494545e+12, 1.153522e+13, 2.48…
## $ `Q2 2024` <dbl> 1.296771e+13, 1.071481e+13, 2.252909e+12, 1.153787e+13, 2.24…
## $ `Q3 2024` <dbl> 1.496249e+13, 1.052443e+13, 4.438053e+12, 1.353531e+13, 4.42…
## $ `Q4 2024` <dbl> 1.720773e+13, 1.125531e+13, 5.952424e+12, 1.569260e+13, 5.94…
## $ `Q1 2025` <dbl> 1.741932e+13, 1.173029e+13, 5.689026e+12, 1.594966e+13, 5.67…
## $ `Q2 2025` <dbl> 1.715378e+13, 1.196938e+13, 5.184392e+12, 1.571393e+13, 5.17…

Code này đọc và kiểm tra cấu trúc một file Excel chứa báo cáo tài chính.

• Tạo biến data_path2 để lưu đường dẫn file. Điều này giúp Ta chỉ cần sửa một nơi khi đường dẫn thay đổi.
• Dùng file.exists() để xác nhận file tồn tại. Nếu không, stop() dừng chương trình và báo lỗi để ngăn các vấn đề phát sinh sau này.
• Đọc dữ liệu từ sheet đầu tiên bằng hàm readxl::read_excel. Kết quả được lưu vào biến df_raw, cho biết đây là dữ liệu thô.
• Dùng dplyr::glimpse() để xem tóm tắt cấu trúc dữ liệu. Hàm này hiển thị thông tin rõ ràng khi có nhiều cột.

Kết quả cho thấy dữ liệu có cấu trúc dạng rộng (wide format).

• Bảng dữ liệu có 17 dòng và 35 cột.
• Mỗi dòng là một chỉ số tài chính, xác định bởi cột Indicator.
• Các cột còn lại, như Q1 2017, chứa giá trị của các chỉ số theo từng quý.

4.2 Tái cấu trúc dữ liệu

Code này tái cấu trúc dữ liệu từ dạng rộng sang dạng dài để Ta phân tích chuỗi thời gian.

• Chuyển tên hàng: Dùng column_to_rownames để chuyển cột Indicator thành tên hàng. Việc này tách dữ liệu chữ ra khỏi dữ liệu số, chuẩn bị cho bước chuyển vị.
• Chuyển vị: Dùng hàm t() để hoán đổi hàng và cột. Các chỉ số tài chính trở thành cột, các quý trở thành hàng.
• Ép kiểu số: Dùng lapply và as.numeric để đảm bảo mọi cột dữ liệu đều là kiểu số. Đây là bước an toàn để chuẩn bị cho tính toán.
• Phục hồi tên hàng: Gán lại tên hàng (các quý) vì bước ép kiểu số đã làm mất chúng.

Cấu trúc dữ liệu mới đã sẵn sàng cho phân tích.

• Mỗi hàng là một quan sát tại một thời điểm.
• Mỗi cột là một biến số tài chính.
• Tất cả các biến đều ở định dạng số.

4.3 Chuẩn Hóa Đơn Vị

# Đơn vị (Ngàn tỷ)
df_numeric <- df_numeric / 1e12

# In 5 dòng đầu tiên của dữ liệu đã chuẩn hóa để kiểm tra
print(t(head(df_numeric, 1)))

##              Q1 2017
## ta       3.595808173
## equity   1.749065808
## tl       1.846742365
## ca       3.106733885
## cl       1.784913164
## inv_net  2.846786699
## ar       0.040388070
## ap       0.323535911
## revenue  3.130971058
## cogs    -2.580113338
## gp       0.550857720
## ebit     0.311240665
## ebt      0.311075206
## ni       0.248739097
## cfo      0.204604720
## cfi     -0.007393507
## cff     -0.225897519

Code này chuẩn hóa đơn vị dữ liệu.

• Chia toàn bộ dữ liệu cho 1 nghìn tỷ (1e12).
• Thao tác này đổi đơn vị các giá trị từ Đồng sang Nghìn tỷ Đồng.
• R thực hiện phép tính này trên mọi ô dữ liệu cùng lúc. Điều này an toàn vì Ta đã đảm bảo tất cả các cột đều là số.

4.4 Feature Engineering

df_analysis <- df_numeric

# cogs nên dương (magnitude)
if ("cogs" %in% names(df_analysis)) {
  df_analysis$cogs <- abs(df_analysis$cogs)
  message("[INFO] Đã chuẩn hóa 'cogs' sang giá trị dương.")
} else {
  warning("[WARN] Không tìm thấy cột 'cogs'.")
}

## [INFO] Đã chuẩn hóa 'cogs' sang giá trị dương.

# Các biến nên dương tuyệt đối
positive_cols <- c('ta', 'equity', 'tl', 'ca', 'cl', 'inv_net', 'ar', 'ap', 'revenue')
for (col in positive_cols) {
  if (col %in% names(df_analysis)) {
    df_analysis[[col]] <- abs(df_analysis[[col]])
  } else {
    warning(paste("[WARN] Không tìm thấy cột '", col, "' để chuẩn hóa dương.", sep=""))
  }
}
message("[INFO] Hoàn tất chuẩn hóa nền tảng.")

## [INFO] Hoàn tất chuẩn hóa nền tảng.

Code này làm sạch dữ liệu bằng cách áp dụng các quy tắc tài chính.

• Tạo một bản sao dữ liệu tên df_analysis. Hành động này bảo vệ dữ liệu gốc của Ta.
• Chuyển đổi giá trị của cột cogs thành số dương bằng hàm abs(). Dữ liệu kế toán thường ghi cogs là số âm, nhưng phân tích cần độ lớn thực của chi phí.
• Định nghĩa một danh sách các cột phải có giá trị dương, ví dụ như ta (tổng tài sản).
• Code dùng một vòng lặp để áp dụng hàm abs() cho tất cả các cột trong danh sách đó.

4.5 Các hàm tiện ích

# Hàm tiện ích dùng xuyên suốt
avg_lag1 <- function(x) {
  (x + dplyr::lag(x, n = 1)) / 2
}

Code này tạo ra các hàm để tiện tính toán trong quá trình phân tích

• Tạo hàm avg_lag1 để tính trung bình của một giá trị tại kỳ hiện tại và kỳ trước đó.
• Hàm dùng dplyr::lag() để lấy giá trị của kỳ trước, sau đó tính trung bình cộng của giá trị hiện tại và giá trị đó.

Mục đích:

• Ta không thể so sánh một số liệu đo lường trong một kỳ (như lợi nhuận) với một số liệu đo tại một thời điểm (như tài sản).
• Giải pháp là Ta phải dùng giá trị tài sản trung bình trong kỳ đó.
• Hàm avg_lag1 tính toán chính xác giá trị trung bình này, giúp các tỷ số tài chính chính xác hơn.

4.5.1 Biên lợi nhuận

# 1) Khả năng sinh lời — Biên lợi nhuận
if (all(c("gp","ebit","ni","revenue") %in% names(df_analysis))) {
  df_analysis <- df_analysis %>%
    dplyr::mutate(
      gross_margin = gp / revenue,
      operating_margin = ebit / revenue,
      net_margin = ni / revenue
    )
  message("[INFO] Đã tính biên lợi nhuận (gross/operating/net).")
} else {
  warning("[WARN] Thiếu một trong gp/ebit/ni/revenue — bỏ qua margins.")
}

## [INFO] Đã tính biên lợi nhuận (gross/operating/net).

Code này tính toán các biên lợi nhuận để đánh giá khả năng sinh lời của công ty.

• Ta dùng all() để đảm bảo các cột gp, ebit, ni, và revenue đều tồn tại.
• Ta dùng dplyr::mutate để tạo ba cột mới: gross_margin, operating_margin, và net_margin.

Mỗi biên lợi nhuận đo lường hiệu quả ở một giai đoạn khác nhau

• Biên lợi nhuận gộp: Đo lường hiệu quả sản xuất.
• Biên lợi nhuận hoạt động: Đo lường hiệu quả kinh doanh cốt lõi.
• Biên lợi nhuận ròng: Đo lường lợi nhuận cuối cùng.

4.5.2 Biến trung bình

# Biến trung bình cho ROA/ROE/Efficiency
need <- c("ta","equity","inv_net","ar")
if (any(need %in% names(df_analysis))) {
  df_analysis <- df_analysis %>%
    dplyr::mutate(
      avg_ta = avg_lag1(ta),
      avg_equity = avg_lag1(equity),
      avg_inv_net = avg_lag1(inv_net),
      avg_ar = avg_lag1(ar)
    )
  message("[INFO] Đã tạo các biến trung bình: avg_ta, avg_equity, avg_inv_net, avg_ar.")
}

## [INFO] Đã tạo các biến trung bình: avg_ta, avg_equity, avg_inv_net, avg_ar.

Code này tạo ra các cột dữ liệu trung bình để chuẩn bị cho các phép tính tỷ số.

• Áp dụng hàm avg_lag1 đã tạo trước đó.
• Hàm này tạo ra các cột mới như avg_ta và avg_equity, chứa giá trị trung bình của chỉ số gốc và chỉ số kỳ trước.
• Hành động này giải quyết vấn đề so sánh giữa hai loại dữ liệu tài chính.
• Ta không thể chia một chỉ số của cả kỳ (lợi nhuận) cho một chỉ số tại một thời điểm (tài sản).
• Các cột trung bình mới này làm cho các phép tính tỷ số của Ta chính xác về mặt logic.

4.5.3 Tính ROA & ROE

# ROA & ROE
if (all(c("ni","avg_ta","avg_equity") %in% names(df_analysis))) {
  df_analysis <- df_analysis %>%
    dplyr::mutate(
      roa = ni / avg_ta,
      roe = ni / avg_equity
    )
  message("[INFO] Đã tính ROA, ROE.")
} else {
  warning("[WARN] Thiếu ni/avg_ta/avg_equity — bỏ qua ROA/ROE.")
}

## [INFO] Đã tính ROA, ROE.

Code này tính Tỷ suất sinh lời trên tài sản (ROA) và Tỷ suất sinh lời trên vốn chủ sở hữu (ROE).

• Ta dùng mutate để tạo hai cột mới: roa và roe.
• Công thức sử dụng lợi nhuận ròng (ni) và các giá trị tài sản (avg_ta) hoặc vốn chủ sở hữu (avg_equity) trung bình.
• ROA đo lường hiệu quả Ta sử dụng toàn bộ tài sản để sinh lời.
• ROE đo lường lợi nhuận Ta tạo ra cho mỗi đồng vốn của cổ đông.

ROE có thể được phân tích thành ba yếu tố chính.

• Biên lợi nhuận: Khả năng sinh lời trên doanh thu.
• Vòng quay tài sản: Hiệu quả sử dụng tài sản để tạo doanh thu.
• Đòn bẩy tài chính: Mức độ sử dụng nợ để tài trợ cho tài sản.

4.5.4 Tính các giá trị YOY (theo quý)

# 2) Tăng trưởng YOY (theo quý)
if (all(c("revenue","gp","ebit","ni") %in% names(df_analysis))) {
  df_analysis <- df_analysis %>%
    dplyr::mutate(
      revenue_yoy = (revenue / dplyr::lag(revenue, 4)) - 1,
      gp_yoy      = (gp       / dplyr::lag(gp, 4)) - 1,
      ebit_yoy    = (ebit     / dplyr::lag(ebit, 4)) - 1,
      ni_yoy      = (ni       / dplyr::lag(ni, 4)) - 1
    )
  message("[INFO] Đã tính tăng trưởng YOY (revenue/gp/ebit/ni).")
}

## [INFO] Đã tính tăng trưởng YOY (revenue/gp/ebit/ni).

Code này tính toán tăng trưởng so với cùng kỳ năm trước (Year-over-Year).

• Ta dùng dplyr::lag(x, 4) để lấy dữ liệu từ 4 quý trước.
• Con số 4 được chọn vì dữ liệu là theo quý.
• Công thức (hiện tại / quá khứ) - 1 chuyển đổi tỷ lệ thành phần trăm tăng trưởng.

Phép tính này loại bỏ yếu tố mùa vụ.

• So sánh quý 4 với quý 3 thường không chính xác. Doanh thu quý 4 thường cao hơn do các yếu tố mùa vụ.
• So sánh quý 4 năm nay với quý 4 năm ngoái cho thấy mức tăng trưởng thực sự của công ty.
• Công thức tính toán là: (Giá trị hiện tại / Giá trị cùng kỳ năm trước) - 1.

4.5.5 Tỷ số Vòng quay

# 3) Hiệu quả — Vòng quay
if (all(c("revenue","avg_ta","cogs","avg_inv_net","avg_ar") %in% names(df_analysis))) {
  df_analysis <- df_analysis %>%
    dplyr::mutate(
      asset_turnover       = revenue / avg_ta,
      inventory_turnover   = cogs / avg_inv_net,
      receivables_turnover = revenue / avg_ar
    )
  message("[INFO] Đã tính asset/inventory/receivables turnover.")
}

## [INFO] Đã tính asset/inventory/receivables turnover.

Code này tính các tỷ số vòng quay để đo lường hiệu quả hoạt động.

• Vòng quay tổng tài sản: Ta tính bằng revenue chia cho avg_ta. Chỉ số này đo lường Ta tạo ra bao nhiêu doanh thu từ mỗi đồng tài sản.
• Vòng quay hàng tồn kho: Ta tính bằng cogs chia cho avg_inv_net. Ta phải dùng cogs (giá vốn) vì hàng tồn kho được ghi nhận theo giá vốn, không phải giá bán.
• Vòng quay các khoản phải thu: Ta tính bằng revenue chia cho avg_ar. Chỉ số này đo tốc độ Ta thu tiền từ khách hàng.

4.5.6 Chỉ số Hiệu quả

# 3) Hiệu quả — DSO/DIO/DPO/CCC
if (all(c("ar","revenue","inv_net","cogs","ap") %in% names(df_analysis))) {
  df_analysis <- df_analysis %>%
    dplyr::mutate(
      dso = 365 * ar / revenue,
      dio = 365 * inv_net / cogs,
      dpo = 365 * ap / cogs,
      ccc = dso + dio - dpo
    )
  message("[INFO] Đã tính DSO/DIO/DPO/CCC.")
}

## [INFO] Đã tính DSO/DIO/DPO/CCC.

Code này tính toán chu kỳ chuyển đổi tiền mặt.

• Tính Số ngày phải thu bình quân (DSO). Công thức này cho biết Ta mất trung bình bao nhiêu ngày để thu tiền từ khách hàng.
• Tính Số ngày tồn kho bình quân (DIO). Nó đo lường thời gian trung bình để Ta bán hết hàng trong kho.
• Tính Số ngày phải trả bình quân (DPO). Nó cho thấy Ta có bao nhiêu ngày để trả tiền cho nhà cung cấp.
• Tính Chu kỳ chuyển đổi tiền mặt (CCC). Đây là thời gian ròng mà tiền của Ta bị kẹt trong hoạt động kinh doanh, tính bằng công thức DSO + DIO - DPO

4.5.7 Đòn bẩy tài chính

# 4) Đòn bẩy tài chính
if (all(c("tl","equity","ta") %in% names(df_analysis))) {
  df_analysis <- df_analysis %>%
    dplyr::mutate(
      debt_to_equity    = tl / equity,
      financial_leverage = ta / equity
    )
  message("[INFO] Đã tính debt_to_equity, financial_leverage.")
}

## [INFO] Đã tính debt_to_equity, financial_leverage.

Code này tính toán các tỷ số đòn bẩy tài chính để đánh giá rủi ro.

• Tính tỷ số Nợ trên Vốn chủ sở hữu (debt_to_equity). Công thức này cho biết Ta có bao nhiêu đồng nợ cho mỗi đồng vốn chủ sở hữu.
• Tính Đòn bẩy tài chính (financial_leverage). Nó đo lường Ta kiểm soát bao nhiêu đồng tài sản cho mỗi đồng vốn chủ sở hữu.

Các công thức này dựa trên phương trình kế toán:

• Tài sản = Nợ + Vốn chủ sở hữu.
• Đòn bẩy tài chính = Tỷ số Nợ trên Vốn chủ sở hữu + 1.

4.5.8 Thanh khoản

# 5) Thanh khoản
if (all(c("ca","cl","inv_net") %in% names(df_analysis))) {
  df_analysis <- df_analysis %>%
    dplyr::mutate(
      current_ratio = ca / cl,
      quick_ratio   = (ca - inv_net) / cl
    )
  message("[INFO] Đã tính current_ratio, quick_ratio.")
}

## [INFO] Đã tính current_ratio, quick_ratio.

Code này tính toán các tỷ số thanh khoản để đánh giá khả năng trả nợ ngắn hạn.

• Ta tính Tỷ số thanh khoản hiện thời (current_ratio). Công thức này cho biết Ta có bao nhiêu đồng tài sản ngắn hạn để trả cho mỗi đồng nợ ngắn hạn.
• Ta tính Tỷ số thanh khoản nhanh (quick_ratio). Tỷ số này loại bỏ hàng tồn kho. Hàng tồn kho là tài sản khó chuyển thành tiền nhất. Do đó, đây là một bài kiểm tra nghiêm ngặt hơn về khả năng trả nợ của Ta.

So sánh hai tỷ số này để đánh giá rủi ro. Nếu current_ratio cao nhưng quick_ratio thấp, thanh khoản của Ta phụ thuộc vào việc bán hàng tồn kho.

4.5.9 Dòng tiền

# 6) Dòng tiền 
if (all(c("cfo","ni","cfi","revenue") %in% names(df_analysis))) {
  df_analysis <- df_analysis %>%
    dplyr::mutate(
      cfo_ni     = cfo / ni,
      capex_proxy = -pmin(cfi, 0, na.rm = TRUE),
      fcf_proxy   = cfo - capex_proxy,
      fcf_margin  = fcf_proxy / revenue,
      fcf_margin_proxy_crude = (cfo + cfi) / revenue
    )
  message("[INFO] Đã tính CFO/NI, CAPEX proxy, FCF & FCF margin.")
}

## [INFO] Đã tính CFO/NI, CAPEX proxy, FCF & FCF margin.

Code này tính các chỉ số dòng tiền, bao gồm Dòng tiền tự do (FCF).

• Tính tỷ số cfo / ni. Tỷ số này đo lường chất lượng lợi nhuận bằng cách so sánh tiền mặt thực tế với lợi nhuận trên giấy tờ.
• Ước tính Chi tiêu Vốn (CAPEX) bằng công thức -pmin(cfi, 0). Công thức này lọc ra các khoản chi đầu tư âm từ dòng tiền đầu tư (cfi) và đổi nó thành số dương.
• Tính Dòng tiền tự do (FCF) bằng cfo - capex_proxy. Đây là lượng tiền còn lại sau khi trừ chi phí hoạt động và đầu tư.
• Tính Biên Dòng tiền tự do (fcf_margin). Chỉ số này cho biết Ta tạo ra bao nhiêu tiền mặt tự do từ mỗi đồng doanh thu.

4.5.10 EBITDA Margin

#  Conditional — EBITDA margin
if ("ebitda" %in% names(df_analysis) && "revenue" %in% names(df_analysis)) {
  df_analysis <- df_analysis %>% dplyr::mutate(ebitda_margin = ebitda / revenue)
  message("[INFO] Đã tính ebitda_margin.")
} else {
  warning("[WARN] Thiếu ebitda hoặc revenue — bỏ qua ebitda_margin.")
}

Code này tính Biên lợi nhuận EBITDA.

• Dùng mutate để tạo cột ebitda_margin bằng ebitda chia cho revenue.
• Hành động này cho Ta một thước đo lợi nhuận.
• Thước đo này loại bỏ ảnh hưởng từ các quyết định về tài chính, thuế và khấu hao.

So sánh các biên lợi nhuận khác nhau.

• Khoảng cách giữa biên EBITDA và biên hoạt động thể hiện tác động của chi phí khấu hao.
• Khoảng cách giữa biên hoạt động và biên ròng thể hiện tác động của lãi vay và thuế.

4.5.11 ROIC

#  Conditional — ROIC (cần ic & tax_rate)
if (all(c("ic","tax_rate","ebit") %in% names(df_analysis))) {
  df_analysis <- df_analysis %>% dplyr::mutate(
    avg_ic = avg_lag1(ic),
    roic   = ebit * (1 - tax_rate) / avg_ic
  )
  message("[INFO] Đã tính ROIC.")
} else {
  warning("[WARN] Thiếu ic/tax_rate/ebit — bỏ qua ROIC.")
}

Code này tính Tỷ suất sinh lời trên Vốn đầu tư (ROIC) để Ta đo lường khả năng tạo ra giá trị.

• Ta tính Lợi nhuận Hoạt động Ròng Sau Thuế (NOPAT). Công thức là EBIT * (1 - tax_rate).
• Ta tính Vốn đầu tư trung bình (avg_ic). Việc này đảm bảo Ta so sánh lợi nhuận trong kỳ với vốn hoạt động trong kỳ.
• Ta chia NOPAT cho vốn đầu tư trung bình để có ROIC.

Ta phải so sánh ROIC với Chi phí vốn bình quân gia quyền (WACC).

• ROIC > WACC: Công ty tạo ra giá trị.
• ROIC < WACC: Công ty phá hủy giá trị.

4.5.12 Net Debt / EBITDA

#  Conditional — Net Debt / EBITDA
req <- c("st_debt","lt_debt","cash_eq","ebitda")
if (all(req %in% names(df_analysis))) {
  df_analysis <- df_analysis %>% dplyr::mutate(
    net_debt        = st_debt + lt_debt - cash_eq,
    net_debt_ebitda = net_debt / ebitda
  )
  message("[INFO] Đã tính net_debt và net_debt_ebitda.")
} else {
  warning("[WARN] Thiếu một trong st_debt/lt_debt/cash_eq/ebitda — bỏ qua NetDebt/EBITDA.")
}

Code này tính toán tỷ số Nợ ròng trên EBITDA. Ta dùng nó để đánh giá khả năng trả nợ.

• Tính Nợ ròng (net_debt) bằng tổng nợ trừ đi tiền mặt. Công thức này phản ánh gánh nặng nợ thực tế vì Ta có thể dùng tiền mặt để trả nợ ngay lập tức.
• Chia Nợ ròng cho EBITDA. Kết quả cho thấy Ta cần bao nhiêu năm lợi nhuận hoạt động để trả hết nợ.

4.5.13 Tỷ số bảo đảm trả lãi vay

#  Conditional — Interest Coverage
if (all(c("ebit","int_exp") %in% names(df_analysis))) {
  df_analysis <- df_analysis %>% dplyr::mutate(interest_coverage = ebit / abs(int_exp))
  message("[INFO] Đã tính interest_coverage.")
} else {
  warning("[WARN] Thiếu ebit hoặc int_exp — bỏ qua interest_coverage.")
}

Code này tính Tỷ số Bảm đảm Trả lãi vay. Dùng nó để đánh giá mức độ an toàn của công ty.

• Tính tỷ số này bằng ebit chia cho abs(int_exp).
• Phải dùng ebit (lợi nhuận trước lãi vay). Đây là khoản lợi nhuận có sẵn để Ta trả lãi.
• Dùng abs() vì chi phí lãi vay thường là số âm. Hàm này lấy giá trị dương của nó.

4.5.14 Tỷ số tiền mặt

#  Conditional — Cash Ratio
if (all(c("cash_eq","cl") %in% names(df_analysis))) {
  df_analysis <- df_analysis %>% dplyr::mutate(cash_ratio = cash_eq / cl)
  message("[INFO] Đã tính cash_ratio.")
} else {
  warning("[WARN] Thiếu cash_eq hoặc cl — bỏ qua cash_ratio.")
}

Code này tính Tỷ số Tiền mặt. Ta dùng nó để đánh giá khả năng trả nợ trong kịch bản xấu nhất.

• Tính tỷ số này bằng cách chia tiền mặt (cash_eq) cho nợ ngắn hạn (cl).
• Nó chỉ dùng tài sản có thể sử dụng ngay lập tức, bỏ qua các khoản phải thu và hàng tồn kho.

Tỷ số này là bài kiểm tra thanh khoản nghiêm ngặt nhất. Nó nằm trong một hệ thống gồm ba cấp độ:

• Tỷ số thanh khoản hiện thời: Đánh giá chung.
• Tỷ số thanh khoản nhanh: Loại bỏ hàng tồn kho.
• Tỷ số Tiền mặt: Chỉ dùng tiền mặt.

4.5.15 Hàm an toàn

#  Dọn dẹp — thay Inf bằng NA
df_analysis[] <- lapply(df_analysis, function(x) {
  x[is.infinite(x)] <- NA
  x
})
message("[INFO] Hoàn tất tạo biến và dọn dẹp giá trị Inf.")

## [INFO] Hoàn tất tạo biến và dọn dẹp giá trị Inf.

Code này dọn dẹp các giá trị Inf (vô cùng) trong dữ liệu.

• Giá trị Inf xuất hiện khi Ta thực hiện phép chia cho 0.
• Giá trị này gây lỗi cho các phân tích thống kê và thuật toán học máy.
• Code này quét qua toàn bộ dữ liệu của Ta. Nó tìm tất cả các giá trị Inf và thay thế chúng bằng NA.

4.6 Từ điển biến

# 1) Tự đảm bảo có hàm ptbl()
if (!exists("ptbl")) {
  suppressPackageStartupMessages(library(kableExtra))
  ptbl <- function(x, caption = NULL, digits = 3) {
    stopifnot(is.data.frame(x) || inherits(x, "matrix"))
    fmt <- if (knitr::is_latex_output()) "latex" else "html"
    kb <- knitr::kable(x, format = fmt, caption = caption, digits = digits,
                       booktabs = TRUE, longtable = TRUE, linesep = "")
    if (knitr::is_latex_output()) {
      kb |>
        kableExtra::kable_styling(
          latex_options = c("hold_position", "repeat_header", "scale_down"),
          position = "center", font_size = 10
        )
    } else {
      kb |>
        kableExtra::kable_styling(full_width = FALSE,
                                  bootstrap_options = c("striped","condensed")) |>
        kableExtra::scroll_box(width = "100%")
    }
  }
}

# 2) Tạo từ điển biến 
suppressPackageStartupMessages(library(tibble))
dict <- tibble::tribble(
  ~Biến,                ~Mô_tả,                         ~Nhóm,
  "revenue",            "Doanh thu thuần",              "Input",
  "gp",                 "Lợi nhuận gộp",                "Input",
  "ebit",               "EBIT",                         "Input",
  "ni",                 "LN ròng",                      "Input",
  "ta",                 "Tổng tài sản",                 "Input",
  "equity",             "Vốn chủ sở hữu",               "Input",
  "cogs",               "Giá vốn hàng bán",             "Input",
  "inv_net",            "HTK ròng",                     "Input",
  "ar",                 "Phải thu KH",                  "Input",
  "ap",                 "Phải trả NB",                  "Input",
  "ca",                 "TS ngắn hạn",                  "Input",
  "cl",                 "Nợ ngắn hạn",                  "Input",
  "cfo",                "LCTT HĐKD",                    "Input",
  "cfi",                "LCTT HĐĐT",                    "Input",
  "ebitda",             "EBITDA",                       "Optional",
  "st_debt",            "Nợ vay ngắn hạn",              "Optional",
  "lt_debt",            "Nợ vay dài hạn",               "Optional",
  "cash_eq",            "Tiền & TĐT",                   "Optional",
  "tax_rate",           "Thuế suất hiệu dụng",          "Optional",
  "gross_margin",       "Biên gộp",                     "Derived",
  "operating_margin",   "Biên EBIT",                    "Derived",
  "net_margin",         "Biên ròng",                    "Derived",
  "avg_ta",             "TS bình quân",                 "Derived",
  "avg_equity",         "VCSH bình quân",               "Derived",
  "roa",                "ROA",                          "Derived",
  "roe",                "ROE",                          "Derived",
  "asset_turnover",     "Vòng quay TS",                 "Derived",
  "inventory_turnover", "Vòng quay HTK",                "Derived",
  "receivables_turnover","Vòng quay PT",                "Derived",
  "dso",                "DSO (ngày)",                   "Derived",
  "dio",                "DIO (ngày)",                   "Derived",
  "dpo",                "DPO (ngày)",                   "Derived",
  "ccc",                "Chu kỳ tiền (CCC)",            "Derived",
  "debt_to_equity",     "Nợ/VCSH",                      "Derived",
  "current_ratio",      "Current ratio",                "Derived",
  "quick_ratio",        "Quick ratio",                  "Derived",
  "cfo_ni",             "CFO/NI",                       "Derived",
  "fcf_margin",         "Biên FCF",                     "Derived"
)

# 3) In bảng ngay trong chunk
ptbl(dict, caption = "Từ điển biến", digits = 2)

Table 4.1: Từ điển biến

Biến	Mô_tả	Nhóm
revenue	Doanh thu thuần	Input
gp	Lợi nhuận gộp	Input
ebit	EBIT	Input
ni	LN ròng	Input
ta	Tổng tài sản	Input
equity	Vốn chủ sở hữu	Input
cogs	Giá vốn hàng bán	Input
inv_net	HTK ròng	Input
ar	Phải thu KH	Input
ap	Phải trả NB	Input
ca	TS ngắn hạn	Input
cl	Nợ ngắn hạn	Input
cfo	LCTT HĐKD	Input
cfi	LCTT HĐĐT	Input
ebitda	EBITDA	Optional
st_debt	Nợ vay ngắn hạn	Optional
lt_debt	Nợ vay dài hạn	Optional
cash_eq	Tiền & TĐT	Optional
tax_rate	Thuế suất hiệu dụng	Optional
gross_margin	Biên gộp	Derived
operating_margin	Biên EBIT	Derived
net_margin	Biên ròng	Derived
avg_ta	TS bình quân	Derived
avg_equity	VCSH bình quân	Derived
roa	ROA	Derived
roe	ROE	Derived
asset_turnover	Vòng quay TS	Derived
inventory_turnover	Vòng quay HTK	Derived
receivables_turnover	Vòng quay PT	Derived
dso	DSO (ngày)	Derived
dio	DIO (ngày)	Derived
dpo	DPO (ngày)	Derived
ccc	Chu kỳ tiền (CCC)	Derived
debt_to_equity	Nợ/VCSH	Derived
current_ratio	Current ratio	Derived
quick_ratio	Quick ratio	Derived
cfo_ni	CFO/NI	Derived
fcf_margin	Biên FCF	Derived

Code này tạo một từ điển dữ liệu để Ta ghi lại ý nghĩa của tất cả các biến.

• Dùng tibble::tribble để tạo từ điển vì cú pháp của nó rõ ràng. Một hàm khác in từ điển ra thành một bảng chuyên nghiệp.
• Phân loại các biến thành ba nhóm: Input (dữ liệu gốc), Optional (dữ liệu có thể thiếu), và Derived (các biến Ta đã tạo ra).
• Cấu trúc này ghi lại toàn bộ quy trình phân tích của Ta, từ nguyên liệu thô đến sản phẩm cuối cùng.

4.7 Ổn định từ điển

# 1) Tự đảm bảo có hàm ptbl()
if (!exists("ptbl")) {
  suppressPackageStartupMessages(library(kableExtra))
  ptbl <- function(x, caption = NULL, digits = 3) {
    stopifnot(is.data.frame(x) || inherits(x, "matrix"))
    fmt <- if (knitr::is_latex_output()) "latex" else "html"
    kb <- knitr::kable(x, format = fmt, caption = caption, digits = digits,
                       booktabs = TRUE, longtable = TRUE, linesep = "")
    if (knitr::is_latex_output()) {
      kb |>
        kableExtra::kable_styling(
          latex_options = c("hold_position", "repeat_header", "scale_down"),
          position = "center", font_size = 10
        )
    } else {
      kb |>
        kableExtra::kable_styling(full_width = FALSE,
                                  bootstrap_options = c("striped","condensed")) |>
        kableExtra::scroll_box(width = "100%")
    }
  }
}

# 2) Tự đảm bảo có từ điển 
if (!exists("dict")) {
  suppressPackageStartupMessages(library(tibble))
  dict <- tibble::tribble(
    ~Biến, ~Mô_tả, ~Nhóm,
    "revenue","Doanh thu thuần","Input",
    "gp","Lợi nhuận gộp","Input",
    "ebit","EBIT","Input",
    "ni","LN ròng","Input",
    "ta","Tổng tài sản","Input",
    "equity","Vốn chủ sở hữu","Input",
    "cogs","Giá vốn hàng bán","Input",
    "inv_net","HTK ròng","Input",
    "ar","Phải thu KH","Input",
    "ap","Phải trả NB","Input",
    "ca","TS ngắn hạn","Input",
    "cl","Nợ ngắn hạn","Input",
    "cfo","LCTT HĐKD","Input",
    "cfi","LCTT HĐĐT","Input",
    "gross_margin","Biên gộp","Derived",
    "operating_margin","Biên EBIT","Derived",
    "net_margin","Biên ròng","Derived",
    "roa","ROA","Derived",
    "roe","ROE","Derived"
  )
}

# 3) Xác định dữ liệu tham chiếu
suppressPackageStartupMessages(library(dplyr))
data_ref <- if (exists("df_analysis")) df_analysis else if (exists(
"df_numeric")) df_numeric else df_raw
vars_avail <- intersect(dict$Biến, names(data_ref))

# 4) Lọc & in
if (length(vars_avail) == 0) {
  message("[INFO] Không thấy biến nào trong dữ liệu khớp từ điển.")
} else {
  dict_in_use <- dict |>
    dplyr::filter(Biến %in% vars_avail) |>
    dplyr::arrange(Nhóm, Biến) |>
    dplyr::mutate(`Đã có` = "\u2713")
  ptbl(dict_in_use, caption = "Danh mục biến dùng trong phân tích")
}

Table 4.2: Danh mục biến dùng trong phân tích

Biến	Mô_tả	Nhóm	Đã có
asset_turnover	Vòng quay TS	Derived	✓
avg_equity	VCSH bình quân	Derived	✓
avg_ta	TS bình quân	Derived	✓
ccc	Chu kỳ tiền (CCC)	Derived	✓
cfo_ni	CFO/NI	Derived	✓
current_ratio	Current ratio	Derived	✓
debt_to_equity	Nợ/VCSH	Derived	✓
dio	DIO (ngày)	Derived	✓
dpo	DPO (ngày)	Derived	✓
dso	DSO (ngày)	Derived	✓
fcf_margin	Biên FCF	Derived	✓
gross_margin	Biên gộp	Derived	✓
inventory_turnover	Vòng quay HTK	Derived	✓
net_margin	Biên ròng	Derived	✓
operating_margin	Biên EBIT	Derived	✓
quick_ratio	Quick ratio	Derived	✓
receivables_turnover	Vòng quay PT	Derived	✓
roa	ROA	Derived	✓
roe	ROE	Derived	✓
ap	Phải trả NB	Input	✓
ar	Phải thu KH	Input	✓
ca	TS ngắn hạn	Input	✓
cfi	LCTT HĐĐT	Input	✓
cfo	LCTT HĐKD	Input	✓
cl	Nợ ngắn hạn	Input	✓
cogs	Giá vốn hàng bán	Input	✓
ebit	EBIT	Input	✓
equity	Vốn chủ sở hữu	Input	✓
gp	Lợi nhuận gộp	Input	✓
inv_net	HTK ròng	Input	✓
ni	LN ròng	Input	✓
revenue	Doanh thu thuần	Input	✓
ta	Tổng tài sản	Input	✓

Code này tạo một từ điển dữ liệu tự động. Nó kiểm tra dữ liệu của Ta và tạo một báo cáo về các biến hiện có.

• Code tự động tìm phiên bản dữ liệu đầy đủ nhất mà Ta có (df_analysis, df_numeric, hoặc df_raw).
• Nó so sánh từ điển gốc với dữ liệu này để tìm ra các biến thực sự tồn tại.
• Bảng kết quả hiển thị các biến đã tồn tại trong bộ dữ liệu, được sắp xếp và có dấu xác nhận.

4.8 Thống kê mô tả

# 1) Tự đảm bảo có hàm ptbl()
if (!exists("ptbl")) {
  suppressPackageStartupMessages(library(kableExtra))
  ptbl <- function(x, caption = NULL, digits = 3) {
    stopifnot(is.data.frame(x) || inherits(x, "matrix"))
    fmt <- if (knitr::is_latex_output()) "latex" else "html"
    kb <- knitr::kable(x, format = fmt, caption = caption, digits = digits,
                       booktabs = TRUE, longtable = TRUE, linesep = "")
    if (knitr::is_latex_output()) {
      kb |>
        kableExtra::kable_styling(
          latex_options = c("hold_position", "repeat_header", "scale_down"),
          position = "center", font_size = 10
        )
    } else {
      kb |>
        kableExtra::kable_styling(full_width = FALSE,
                                  bootstrap_options = c("striped","condensed")) |>
        kableExtra::scroll_box(width = "100%")
    }
  }
}

# 2) Tự đảm bảo có dict & data_ref
if (!exists("dict")) {
  suppressPackageStartupMessages(library(tibble))
  dict <- tibble::tribble(
    ~Biến, ~Mô_tả, ~Nhóm,
    "revenue","Doanh thu thuần","Input",
    "gp","Lợi nhuận gộp","Input",
    "ebit","EBIT","Input",
    "ni","LN ròng","Input",
    "ta","Tổng tài sản","Input",
    "equity","Vốn chủ sở hữu","Input",
    "cogs","Giá vốn hàng bán","Input",
    "inv_net","HTK ròng","Input",
    "ar","Phải thu KH","Input",
    "ap","Phải trả NB","Input",
    "ca","TS ngắn hạn","Input",
    "cl","Nợ ngắn hạn","Input"
  )
}

data_ref <- if (exists("df_analysis")) df_analysis else if (
  exists("df_numeric")) df_numeric else df_raw
vars_avail <- intersect(dict$Biến, names(data_ref))
num_vars <- vars_avail[sapply(data_ref[vars_avail], is.numeric)]

# 3) Tính & in
if (length(num_vars) > 0) {
  M <- sapply(data_ref[num_vars], function(x) c(
    n = sum(!is.na(x)),
    mean = mean(x, na.rm = TRUE),
    sd = stats::sd(x, na.rm = TRUE),
    min = suppressWarnings(min(x, na.rm = TRUE)),
    max = suppressWarnings(max(x, na.rm = TRUE))
  ))
  summ <- data.frame(Biến = colnames(M), t(M), row.names = NULL, check.names = FALSE)
  ptbl(summ, caption = "Thống kê nhanh các biến số (đơn giản)")
} else {
  message("[INFO] Không có biến số nào để tóm tắt.")
}

Table 4.3: Thống kê nhanh các biến số (đơn giản)

Biến	n	mean	sd	min	max
revenue	34	5.933	2.842	0.877	12.594
gp	34	1.103	0.520	0.156	2.149
ebit	34	0.445	0.269	-0.193	0.941
ni	34	0.352	0.216	-0.160	0.749
ta	34	9.739	4.092	3.561	17.419
equity	34	6.465	3.110	1.735	11.969
cogs	34	4.830	2.337	0.721	10.445
inv_net	34	7.449	3.105	2.847	13.709
ar	34	0.069	0.034	0.027	0.200
ap	34	0.385	0.173	0.128	0.823
ca	34	8.535	3.851	3.055	15.950
cl	34	3.254	1.230	1.313	5.942
cfo	34	0.044	0.707	-1.573	1.887
cfi	34	-0.058	0.282	-0.965	0.767
gross_margin	34	0.186	0.016	0.156	0.219
operating_margin	34	0.067	0.055	-0.221	0.114
net_margin	34	0.053	0.045	-0.182	0.090
avg_ta	33	9.720	3.953	3.578	17.314
avg_equity	33	6.453	3.015	1.742	11.850
roa	33	0.038	0.019	-0.017	0.073
roe	33	0.059	0.030	-0.028	0.110
asset_turnover	33	0.627	0.170	0.096	0.924
inventory_turnover	33	0.669	0.192	0.096	1.039
receivables_turnover	33	91.904	41.495	24.624	164.907
dso	34	5.170	3.535	2.225	18.570
dio	34	668.030	573.493	324.351	3801.405
dpo	34	35.762	25.327	8.158	157.608
ccc	34	637.439	553.836	305.407	3655.352
debt_to_equity	34	0.567	0.194	0.210	1.056
current_ratio	34	2.618	0.730	1.723	5.143
quick_ratio	34	0.319	0.218	0.078	0.814
cfo_ni	34	-0.095	1.663	-3.509	2.565
fcf_margin	34	-0.031	0.120	-0.400	0.168

Code này tính toán và trình bày một bảng thống kê mô tả cho dữ liệu.

• Nó tự động tìm các biến dạng số hiện có trong dữ liệu của Ta.
• Nó dùng hàm sapply để tính toán số lượng (n), trung bình (mean), độ lệch chuẩn (sd), giá trị nhỏ nhất (min), và lớn nhất (max) cho mỗi biến.
• Bảng kết quả giúp Ta nhanh chóng hiểu được xu hướng trung tâm, mức độ biến động và phạm vi giá trị của từng biến. Bảng thống kê này cho Ta những thông tin quan trọng.
• n: Cho biết mức độ đầy đủ của dữ liệu.
• mean: Cho thấy giá trị trung tâm.
• sd: Đo lường sự biến động. sd lớn cho thấy dữ liệu phân tán rộng.
• min/max: Xác định khoảng giá trị. Chúng có thể giúp Ta phát hiện các điểm bất thường, ví dụ như một quý bị lỗ khi min là số âm.

4.9 Cấu hình vẽ biểu đồ

Code này thiết lập một môi trường để Ta vẽ các biểu đồ chuyên nghiệp và nhất quán.

• Ta tạo các công tắc điều khiển. Các biến use_plotly và save_plots cho phép Ta bật chế độ tương tác hoặc tự động lưu file. Ta thay đổi chúng ở một nơi duy nhất.
• Ta tạo các hàm định dạng. Chúng tự động định dạng các con số và tỷ lệ phần trăm trên biểu đồ, đảm bảo tính nhất quán.
• Ta xây dựng một theme tùy chỉnh. Hàm theme_pro định nghĩa phông chữ, màu sắc và bố cục. Ta dùng theme_set để áp dụng nó làm mặc định cho mọi biểu đồ.
• Ta chuẩn bị một data frame mới. Ta chuyển thông tin thời gian từ rownames thành một cột Date thực sự. ggplot2 yêu cầu cột Date này để vẽ biểu đồ chuỗi thời gian chính xác.

# Chuẩn bị dữ liệu cho ggplot: rownames -> Quarter, parse Date từ "Q1 2017"
df_plot <- df_analysis %>%
  tibble::rownames_to_column(var = "Quarter") %>%
  mutate(
    # Tạo cột Date an toàn từ các định dạng phổ biến: "Q1 2017", "2017 Q1", "2017Q1"
    Date = {
      d1 <- suppressWarnings(as.Date(zoo::as.yearqtr(
      Quarter, format = "Q%q %Y")))
      
      d2 <- suppressWarnings(as.Date(zoo::as.yearqtr(
      stringr::str_replace(Quarter, "^(\\d{4})Q(\\d)$", "Q\\2 \\1"),
                                                    format = "Q%q %Y")))
      
      d3 <- suppressWarnings(as.Date(zoo::as.yearqtr(
      stringr::str_replace(Quarter, "^(\\d{4})\\s*Q(\\d)$", "Q\\2 \\1"),
                                                    format = "Q%q %Y")))
      
      dplyr::coalesce(d1, d2, d3)
    },
    Year = factor(stringr::str_extract(Quarter, "\\d{4}$")), # Cũng sửa ở đây
    qtr  = as.integer(((as.integer(format(Date, "%m")) - 1) %/% 3) + 1),
    yr   = as.integer(format(Date, "%Y"))
  ) %>%
  arrange(Date)

message("Đã tạo 'df_plot' sẵn sàng cho trực quan hóa.")

theme_pro <- function() {
  theme_minimal(base_family = "sans", base_size = 12) +
  theme(
    plot.title = element_text(face = "bold", size = 16, color = "#222222"),
    plot.subtitle = element_text(size = 12, color = "#555555", margin = margin(b = 10)),
    plot.caption = element_text(size = 9, color = "#888888", face = "italic", hjust = 0),
    axis.title = element_text(face = "bold", size = 11, color = "#333333"),
    axis.text = element_text(size = 10, color = "#444444"),
    legend.position = "bottom",
    legend.title = element_blank(),
    panel.grid.minor = element_blank(),
    panel.grid.major.x = element_blank(),
    panel.grid.major.y = element_line(color = "#E5E7EB", linetype = "dashed"),
    plot.background = element_rect(fill = "#FAFAFA", color = NA),
    panel.background = element_rect(fill = "#FAFAFA", color = NA),
    strip.text = element_text(face = "bold", size = 12, hjust = 0, color = "#333333"),
    plot.margin = margin(15, 15, 15, 15)
  )
}

theme_set(theme_pro())

# Breaks theo năm + xoay nhãn
date_break_years <- function(n = 1) list(
  scale_x_date(date_breaks = paste0(n, " year"), date_labels = "%Y"),
  theme(axis.text.x = element_text(angle = 45, hjust = 1))
)
add_xdate <- function(p, n = 1) { if (inherits(p, 'gg')) p + date_break_years(n) else p }

# Hệ số trục phụ an toàn
safe_coef <- function(lhs, rhs) {
  a <- suppressWarnings(max(lhs, na.rm = TRUE));
  b <- suppressWarnings(max(rhs, na.rm = TRUE));
  if (!is.finite(a) || !is.finite(b) || b == 0) return(1)
  a / b
}

cap_default <- "Đơn vị: Ngàn Tỷ Đồng đối với số tuyệt đối; % với tỷ lệ. Dữ liệu đã được chuẩn hóa."
num_fmt  <- scales::label_number(big.mark = ".", decimal.mark = ",")
pct_fmt  <- scales::label_percent(accuracy = 0.1, big.mark = ".", decimal.mark = ",")
qty_fmt  <- scales::label_number(accuracy = 0.1, big.mark = ",", decimal.mark = ",")

Code này thiết lập một môi trường để vẽ các biểu đồ chuyên nghiệp và nhất quán.

• Ta chuẩn bị một data frame mới. Ta chuyển thông tin thời gian từ rownames thành một cột Date thực sự. ggplot2 yêu cầu cột Date này để vẽ biểu đồ chuỗi thời gian chính xác.
• Ta xây dựng một theme tùy chỉnh. Hàm theme_pro định nghĩa phông chữ, màu sắc và bố cục. Ta dùng theme_set để áp dụng nó làm mặc định cho mọi biểu đồ.

5 Phân tích Thống kê và Trực quan hóa Dữ liệu từ BCTC PNJ

---

5.1 Phân tích Tăng trưởng & Quy mô

5.1.1 Doanh thu & Tăng trưởng YoY

if (all(c("revenue","revenue_yoy","Date") %in% names(df_plot))) {

  # Tính hệ số quy đổi cho trục phụ
  s <- safe_coef(df_plot$revenue, df_plot$revenue_yoy)

  # Bảng màu
  col_rev        <- "#2563EB"  # xanh royal cho cột
  col_yoy        <- "#F9F316"  # đường YoY
  col_yoy_trend  <- "#FB923C"  # xu hướng
  zero_line      <- 0 * s

  # (MỚI) Độ rộng cột ~ 80% khoảng cách giữa các mốc thời gian
  bw <- max(10, as.numeric(median(diff(sort(unique(df_plot$Date))))) * 0.8)

  # Điểm cuối để gắn nhãn % YoY
  last_df <- df_plot %>%
    dplyr::filter(!is.na(revenue_yoy), !is.na(Date)) %>%
    dplyr::slice_tail(n = 1) %>%
    dplyr::mutate(
      y_scaled  = revenue_yoy * s,
      yoy_label = scales::percent(revenue_yoy, accuracy = 0.1)
    )

  p1 <- ggplot(df_plot, aes(x = Date)) +
    # --- CỘT DOANH THU (to hơn) ---
    geom_col(aes(y = revenue, fill = "Revenue"),
             width = bw, alpha = 0.95, color = NA) +
    # --- ĐƯỜNG 0% của YoY ---
    geom_hline(yintercept = zero_line, linetype = "dotted", color = "#9CA3AF") +

    # --- Hiệu ứng glow cho YoY ---
    geom_line(aes(y = revenue_yoy * s),
              linewidth = 2.2, color = col_yoy, alpha = 0.12, 
              show.legend = FALSE) +

    # --- Đường & điểm YoY ---
    geom_line(aes(y = revenue_yoy * s, color = "YoY"),
              linewidth = 1.25, lineend = "round") +
    geom_point(aes(y = revenue_yoy * s, color = "YoY"), size = 2.1, stroke = 0.2) +

    # --- Xu hướng LOESS của YoY ---
    geom_smooth(aes(y = revenue_yoy * s, color = "YoY (LOESS)"),
                method = "loess", se = FALSE, linewidth = 0.9, span = 0.5) +

    # --- Nhãn % tại điểm cuối ---
    geom_text(data = last_df,
              aes(x = Date, y = y_scaled, label = yoy_label),
              vjust = -0.8, size = 3.3, color = col_yoy) +

    # --- Thang & trục ---
    scale_y_continuous(
      name = "Doanh thu (Ngàn Tỷ)", labels = num_fmt,
      expand = expansion(mult = c(0.02, 0.1)),
      sec.axis = sec_axis(~ . / s, name = "Tăng trưởng YoY", labels = pct_fmt)
    ) +
    scale_fill_manual(values = c("Revenue" = col_rev)) +
    scale_color_manual(values = c("YoY" = col_yoy, "YoY (LOESS)" = col_yoy_trend)) +

    labs(
      title = "Doanh thu & Tăng trưởng YoY",
      x = NULL, caption = cap_default
    ) +
    guides(fill = guide_legend(order = 1), color = guide_legend(order = 2)) +
    theme_pro() +
    theme(
      legend.box = "horizontal",
      plot.title.position = "plot"
    )

  print(maybe_plotly(add_xdate(p1)))
  maybe_save(add_xdate(p1), "01_revenue_yoy_dual_axis.png") }

Phân tích Code:

• Dùng geom_col để vẽ các cột doanh thu trên trục chính bên trái.
• Dùng geom_line và geom_smooth để vẽ các đường tăng trưởng trên trục phụ bên phải.
• Kỹ thuật trục phụ hoạt động bằng cách nhân dữ liệu trục phụ với một hệ số s, sau đó dùng sec_axis(~ . / s) để hiển thị lại giá trị gốc.
• Dùng geom_smooth với phương pháp loess để làm nổi bật xu hướng dài hạn, loại bỏ các biến động nhiễu trong ngắn hạn.

Kết quả:

• 2017-2020: Doanh thu tăng trưởng ổn định.
• 2021: Tăng trưởng chững lại.
• 2022: Doanh thu và tốc độ tăng trưởng bùng nổ mạnh mẽ.
• 2023-2025: Tốc độ tăng trưởng quay về mức bình thường khi quy mô công ty đã lớn hơn.

5.1.2 Phân rã Tăng trưởng

cols <- c("revenue_yoy","gp_yoy","ebit_yoy","ni_yoy")
avail <- intersect(cols, names(df_plot))

if (length(avail) >= 2) {
  df_long <- df_plot |>
    dplyr::select(Date, dplyr::all_of(avail)) |>
    tidyr::pivot_longer(-Date, names_to = "metric", values_to = "value") |>
    dplyr::mutate(
      metric_lab = dplyr::recode(
        metric,
        "revenue_yoy" = "Doanh thu (YoY)",
        "gp_yoy"      = "Lợi nhuận gộp (YoY)",
        "ebit_yoy"    = "EBIT (YoY)",
        "ni_yoy"      = "Lợi nhuận ròng (YoY)"
      )
    )

  # Màu sắc đậm nhưng dịu, phân biệt tốt
  pal_yoy <- c(
    "Doanh thu (YoY)"      = "#2563EB",
    "Lợi nhuận gộp (YoY)"  = "#10B981",
    "EBIT (YoY)"           = "#F59E0B",
    "Lợi nhuận ròng (YoY)" = "#EF4444"
  )

  # Nhãn ở điểm gần nhất hiện có
  last_pts <- df_long |>
    dplyr::filter(!is.na(value)) |>
    dplyr::group_by(metric_lab) |>
    dplyr::slice_max(order_by = Date, n = 1, with_ties = FALSE) |>
    dplyr::ungroup() |>
    dplyr::mutate(lbl = scales::percent(value, accuracy = 0.1))

  has_repel <- requireNamespace("ggrepel", quietly = TRUE)

  p2 <- ggplot(df_long, aes(Date, value, color = metric_lab, group = metric_lab)) +
    geom_hline(yintercept = 0, linetype = "dotted", color = "#9CA3AF") +
    geom_line(linewidth = 1.05, lineend = "round") +
    geom_point(size = 1.9, stroke = 0.4, shape = 21, fill = "white", show.legend = FALSE) +
    {
      if (has_repel) {
        ggrepel::geom_text_repel(
          data = last_pts, aes(label = lbl),
          size = 3.2, segment.color = "#D1D5DB",
          box.padding = 0.25, point.padding = 0.2,
          max.overlaps = Inf, seed = 1
        )
      } else {
        geom_text(data = last_pts, aes(label = lbl), vjust = -0.6, size = 3.2)
      }
    } +
    scale_color_manual(values = pal_yoy) +
    scale_y_continuous(labels = pct_fmt, breaks = scales::breaks_pretty(n = 4)) +
    labs(
      title = "Phân rã tăng trưởng YoY (tách theo chỉ tiêu)",
      subtitle = "Mỗi ô một chỉ tiêu, trục Y riêng giúp nhìn xu hướng rõ ràng hơn.",
      x = NULL, y = "Tăng trưởng YoY", caption = cap_default
    ) +
    theme_pro() +
    theme(legend.position = "none") +
    facet_wrap(~ metric_lab, ncol = 2, scales = "free_y")

  print(maybe_plotly(add_xdate(p2)))
  maybe_save(add_xdate(p2), "02_growth_decomposition_facets.png")
}

Phân tích Code:

• Dùng pivot_longer để chuyển dữ liệu từ dạng rộng sang dạng dài. ggplot2 yêu cầu định dạng này để tạo biểu đồ.
• Dùng facet_wrap để tạo một biểu đồ nhỏ riêng cho mỗi chỉ tiêu.
• Dùng scales = "free_y". Đây là tham số quan trọng nhất. Nó cho phép mỗi biểu đồ nhỏ có trục tung riêng, giúp các biến động nhỏ không bị ẩn đi.

Kết quả:

• Cả bốn chỉ tiêu đều có chung một mẫu hình tăng trưởng, với một đỉnh đột biến vào năm 2022.
• Tuy nhiên, biên độ tăng trưởng của EBIT và Lợi nhuận ròng thấp hơn và biến động mạnh hơn so với Doanh thu.
• Điều này cho thấy chi phí hoạt động đã tăng. Tăng trưởng doanh thu không được chuyển đổi hiệu quả thành lợi nhuận ròng.

5.1.3 Cấu trúc Tài sản

if (all(c("ta","ca","Date") %in% names(df_plot))) {

  # Chuẩn bị dữ liệu + đặt tên hiển thị đẹp
  df_area <- df_plot |>
    dplyr::transmute(
      Date,
      `Tài sản ngắn hạn (CA)`      = ca,
      `Tài sản dài hạn (TA-CA)`    = ta - ca
    ) |>
    tidyr::pivot_longer(-Date, names_to = "Khoản mục", values_to = "Giá trị") |>
    dplyr::mutate(`Khoản mục` = factor(
      `Khoản mục`,
      levels = c("Tài sản ngắn hạn (CA)", "Tài sản dài hạn (TA-CA)")
    ))

  # Nhãn % tại quý gần nhất (đặt giữa mỗi lớp)
  labels_last <- df_area |>
    dplyr::filter(Date == max(Date, na.rm = TRUE)) |>
    dplyr::arrange(`Khoản mục`) |>
    dplyr::mutate(
      Tổng   = sum(`Giá trị`, na.rm = TRUE),
      Tỷ_trọng = dplyr::if_else(is.finite(Tổng) & Tổng != 0, `Giá trị`/Tổng, NA_real_),
      y_mid  = cumsum(`Giá trị`) - `Giá trị`/2
    ) |>
    dplyr::filter(!is.na(Tỷ_trọng)) |>
    dplyr::mutate(lbl = scales::percent(Tỷ_trọng, accuracy = 0.1))

  # Bảng màu: teal + violet (tươi, dễ phân biệt)
  pal_asset <- c(
    "Tài sản ngắn hạn (CA)"   = "#06B6D4",  # teal
    "Tài sản dài hạn (TA-CA)" = "#8B5CF6"   # violet
  )

  p3 <- ggplot(df_area, aes(Date, `Giá trị`, fill = `Khoản mục`, group = `Khoản mục`)) +
    # nền nhẹ giúp nổi khối
    annotate("rect", xmin = -Inf, xmax = Inf, ymin = 0, ymax = Inf,
             fill = "#F8FAFC", alpha = 0.6) +
    # stacked area
    geom_area(alpha = 0.92, color = NA) +
    # nhãn % trong ô ở quý gần nhất (màu chữ trắng, không viền)
    geom_label(
      data = labels_last,
      aes(x = max(df_area$Date, na.rm = TRUE), y = y_mid, label = lbl, fill = `Khoản mục`),
      color = "white", size = 3.2, label.size = 0, label.padding = grid::unit(0.12, "lines"),
      inherit.aes = FALSE
    ) +
    scale_fill_manual(values = pal_asset) +
    scale_y_continuous(labels = num_fmt, expand = expansion(mult = c(0.02, 0.12))) +
    labs(
      title = "Cấu trúc Tài sản",
      subtitle = "Stacked area: CA vs. (TA−CA). Nhãn hiển thị tỷ trọng tại quý gần nhất.",
      x = NULL, y = "Ngàn Tỷ", caption = cap_default
    ) +
    theme_pro() +
    theme(
      legend.position = "top",
      legend.box = "horizontal",
      plot.title.position = "plot"
    )

  print(maybe_plotly(add_xdate(p3)))
  maybe_save(add_xdate(p3), "03_asset_structure.png")
}

Phân tích Code:

• Tính tài sản dài hạn bằng ta - ca, sau đó dùng pivot_longer để chuyển dữ liệu sang dạng dài. Định dạng này là yêu cầu để ggplot2 vẽ biểu đồ xếp chồng.
• Tính toán vị trí của các nhãn phần trăm. Công thức này đặt chúng vào giữa mỗi lớp diện tích tại điểm dữ liệu cuối cùng.
• Dùng geom_area để vẽ biểu đồ và geom_label để thêm các nhãn đã tính toán. Biểu đồ này cho thấy:

Kết quả:

• Tổng tài sản của công ty tăng trưởng đều đặn.
• Tài sản ngắn hạn chiếm phần lớn, khoảng 91.6% tại điểm cuối. Cấu trúc này ổn định qua thời gian.
• Có thể kết luận đây là một doanh nghiệp thâm dụng vốn lưu động, ví dụ như ngành bán lẻ, phụ thuộc vào việc quản lý hàng tồn kho và các khoản phải thu.

5.2 Nhóm chỉ số liên quan tới ROE vs ROA

5.2.1 ROE vs ROA

if (all(c("roe","roa","Date") %in% names(df_plot))) {

  # 1) Dữ liệu gốc
  df_lr <- df_plot |>
    dplyr::arrange(Date) |>
    dplyr::transmute(Date, ROE = roe, ROA = roa)

  # 2) Chèn điểm giao nhau (gap = 0) giữa hai quý nếu có đổi dấu
  add_crossings <- function(d){
    d <- d[order(d$Date), ]
    out <- d[1, , drop = FALSE]
    if (nrow(d) >= 2) {
      for (i in seq_len(nrow(d) - 1)) {
        r1 <- d[i, ]; r2 <- d[i + 1, ]
        g1 <- r1$ROE - r1$ROA; g2 <- r2$ROE - r2$ROA
        if (is.finite(g1) && is.finite(g2) && g1 * g2 < 0) {
          t <- abs(g1) / (abs(g1) + abs(g2))                    # t ∈ (0,1)
          cross <- r1
          cross$Date <- r1$Date + as.difftime(as.numeric(r2$Date - r1$Date) * t, units = "days")
          cross$ROE  <- r1$ROE + (r2$ROE - r1$ROE) * t
          cross$ROA  <- r1$ROA + (r2$ROA - r1$ROA) * t
          out <- rbind(out, cross, r2)
        } else {
          out <- rbind(out, r2)
        }
      }
    }
    out
  }

  rib <- add_crossings(df_lr) |>
    dplyr::filter(!is.na(ROE), !is.na(ROA)) |>
    dplyr::mutate(
      gap  = ROE - ROA,
      ymin = pmin(ROE, ROA),
      ymax = pmax(ROE, ROA),
      sign = ifelse(gap >= 0, "Đòn bẩy dương (ROE > ROA)", "Đòn bẩy âm (ROE < ROA)")
    ) |>
    dplyr::arrange(Date) |>
    dplyr::mutate(                           # chia polygon theo đoạn cùng dấu
      sg  = ifelse(gap >= 0, 1L, -1L),
      grp = cumsum(dplyr::coalesce(sg != dplyr::lag(sg), FALSE))
    )

  # Nhãn Δ tại quý gần nhất có đủ cặp
  last_pair <- rib |>
    dplyr::slice_tail(n = 1) |>
    dplyr::mutate(
      y_mid     = (ROE + ROA) / 2,
      label_gap = paste0(ifelse(gap >= 0, "+", ""),
                         scales::number(gap * 100, accuracy = 0.1, decimal.mark = ","),
                         " điểm %"),
      col_gap   = ifelse(gap >= 0, "#10B981", "#EF4444")
    )

  col_line <- c("ROE" = "#F59E0B", "ROA" = "#2563EB")
  col_fill <- c("Đòn bẩy dương (ROE > ROA)" = "#10B981",
                "Đòn bẩy âm (ROE < ROA)"   = "#EF4444")

  # Zoom trục Y ~30% (thu hẹp phạm vi để phóng lớn)
  rng <- range(c(df_lr$ROE, df_lr$ROA), na.rm = TRUE)
  mid <- mean(rng); half <- diff(rng) / 2
  ylim_zoom <- c(mid - half * 0.70, mid + half * 0.70)

  p6 <- ggplot() +
    annotate("rect", xmin=-Inf, xmax=Inf, ymin=0, ymax=Inf, fill="#F8FAFC", alpha=.6) +
    geom_ribbon(data = rib,
                aes(Date, ymin = ymin, ymax = ymax, fill = sign, group = grp),
                alpha = .25, show.legend = TRUE) +
    geom_line(data = df_lr, aes(Date, ROE), linewidth = 2, color = col_line["ROE"], alpha = .12) +
    geom_line(data = df_lr, aes(Date, ROE, color = "ROE"), linewidth = 1.25, lineend = "round") +
    geom_point(data = df_lr, aes(Date, ROE, color = "ROE"), size = 2, stroke = .3) +
    geom_line(data = df_lr, aes(Date, ROA), linewidth = 2, color = col_line["ROA"], alpha = .12) +
    geom_line(data = df_lr, aes(Date, ROA, color = "ROA"), linewidth = 1.25, lineend = "round") +
    geom_point(data = df_lr, aes(Date, ROA, color = "ROA"), size = 2, stroke = .3) +
    geom_hline(yintercept = 0, linetype = "dotted", color = "#9CA3AF") +
    geom_label(
      data = last_pair,
      aes(Date, y_mid, label = label_gap),
      inherit.aes = FALSE, size = 2, label.size = 0, fill = "white",
      color = last_pair$col_gap[1], fontface = "bold"
    ) +
    scale_y_continuous(labels = pct_fmt, expand = expansion(mult = c(.06, .18))) +
    scale_color_manual(values = col_line, name = NULL) +
    scale_fill_manual(values = col_fill,  name = NULL) +
    scale_x_date(expand = expansion(add = c(30, 150)), date_breaks = "1 year", date_labels = "%Y") +
    coord_cartesian(ylim = ylim_zoom, clip = "off") +
    labs(
      title = "ROE vs ROA",
      x = NULL, y = "Tỷ lệ", caption = cap_default
    ) +
    theme_pro() +
    theme(legend.position = "top", legend.box = "horizontal",
          plot.title.position = "plot", axis.text.x = element_text(angle = 45, hjust = 1))

  print(maybe_plotly(p6))
  maybe_save(p6, "06_roe_roa.png")
}

Phân tích Code:

• Dùng geom_ribbon để tô màu vùng giữa hai đường ROE và ROA.
• Dùng hàm add_crossings. Hàm này chèn thêm các điểm dữ liệu tại đúng vị trí hai đường cắt nhau. Việc này đảm bảo vùng tô màu chính xác.
• Tạo một biến nhóm grp. Biến này giúp geom_ribbon vẽ các vùng màu riêng biệt cho từng giai đoạn đòn bẩy dương và âm.
• Các lớp khác như geom_line và geom_point được vẽ lên trên để làm rõ xu hướng của từng chỉ số.

Kết quả:

• Vùng màu xanh lá: ROE > ROA. Việc dùng nợ đã khuếch đại lợi nhuận cho cổ đông (đòn bẩy dương).
• Vùng màu đỏ: ROE < ROA. Chi phí lãi vay cao hơn lợi nhuận tài sản tạo ra, làm giảm lợi nhuận của cổ đông (đòn bẩy âm).
• Phân tích:
  • Công ty chủ yếu sử dụng đòn bẩy hiệu quả.
  • Vào cuối năm 2021, cả hai chỉ số đều âm. Quan trọng là ROE giảm sâu hơn ROA, cho thấy gánh nặng lãi vay đã làm tình hình tồi tệ hơn.
  • Khoảng cách giữa ROE và ROA đang có xu hướng thu hẹp.

5.2.2 DuPont 3 thành tố

if (all(c("roe","net_margin","asset_turnover","financial_leverage","Date") %in% names(df_plot))) {

  # Hệ số quy đổi an toàn cho trục phụ
  s <- suppressWarnings(
    max(df_plot$roe, na.rm = TRUE) /
      max(c(df_plot$net_margin, df_plot$asset_turnover, df_plot$financial_leverage), na.rm = TRUE)
  )
  if (!is.finite(s) || s <= 0) s <- 1

  uq  <- sort(unique(df_plot$Date))
  step_days <- if (length(uq) > 1) median(diff(uq)) else 90
  bar_w <- as.numeric(step_days) * 0.75  # ~75% khoảng cách giữa 2 quý

  # Long-format cho các thành tố
  comps <- df_plot %>%
    dplyr::select(Date, net_margin, asset_turnover, financial_leverage) %>%
    tidyr::pivot_longer(-Date, names_to = "component", values_to = "value") %>%
    dplyr::mutate(
      component_lab = dplyr::recode(
        component,
        net_margin        = "Net margin",
        asset_turnover    = "Asset turnover",
        financial_leverage= "Financial leverage"
      ),
      value_scaled = value * s
    )

  # Nhãn ở quý gần nhất
  last_labels <- comps %>%
    dplyr::filter(!is.na(value)) %>%
    dplyr::group_by(component_lab) %>%
    dplyr::slice_max(order_by = Date, n = 1, with_ties = FALSE) %>%
    dplyr::ungroup() %>%
    dplyr::mutate(
      label = dplyr::case_when(
        component_lab == "Net margin"        ~ scales::percent(value, accuracy = 0.1),
        component_lab == "Asset turnover"    ~ scales::number(value, accuracy = 0.01, suffix = "x",
                                                             big.mark = ".", decimal.mark = ","),
        component_lab == "Financial leverage"~ scales::number(value, accuracy = 0.01, suffix = "x",
                                                             big.mark = ".", decimal.mark = ","),
        TRUE ~ as.character(value)
      )
    )

  # Bảng màu
  col_bar  <- "#22C55E"  # ROE (emerald)
  col_line <- c(
    "Net margin"         = "#0EA5E9",
    "Asset turnover"     = "#F59E0B",
    "Financial leverage" = "#8B5CF6"
  )

  has_repel <- requireNamespace("ggrepel", quietly = TRUE)

  p7 <- ggplot() +
    annotate("rect", xmin = -Inf, xmax = Inf, ymin = 0, ymax = Inf,
             fill = "#F8FAFC", alpha = 0.6) +

    # CỘT ROE
    geom_col(data = dplyr::filter(df_plot, !is.na(roe)),
             aes(Date, roe), width = bar_w,
             fill = col_bar, alpha = 0.92, color = NA, na.rm = TRUE) +

    # GLOW + ĐƯỜNG CÁC THÀNH TỐ (đã scale sang trục trái)
    geom_line(data = comps, aes(Date, value_scaled, color = component_lab),
              linewidth = 2.3, alpha = 0.10, show.legend = FALSE) +
    geom_line(data = comps, aes(Date, value_scaled, color = component_lab),
              linewidth = 1.25, lineend = "round") +
    geom_point(data = comps, aes(Date, value_scaled, color = component_lab),
               size = 1.9, stroke = 0.3, show.legend = FALSE) +

    # NHÃN Ở QUÝ GẦN NHẤT
    {
      if (has_repel) {
        ggrepel::geom_text_repel(
          data = last_labels,
          aes(Date, value_scaled, label = label, color = component_lab),
          size = 3.1, segment.color = "#D1D5DB",
          box.padding = 0.25, point.padding = 0.2,
          max.overlaps = Inf, seed = 1, show.legend = FALSE
        )
      } else {
        geom_text(
          data = last_labels,
          aes(Date, value_scaled, label = label, color = component_lab),
          vjust = -0.6, size = 3.1, show.legend = FALSE
        )
      }
    } +

    geom_hline(yintercept = 0, linetype = "dotted", color = "#9CA3AF") +

    scale_y_continuous(
      name = "ROE",
      labels = pct_fmt,
      expand = expansion(mult = c(0.05, 0.18)),
      sec.axis = sec_axis(~ . / s, name = "Thành tố DuPont")
    ) +
    scale_color_manual(values = col_line, name = NULL) +
    labs(
      title = "Phân rã DuPont (3 thành tố)",
      x = NULL, caption = cap_default
    ) +
    theme_pro() +
    theme(
      legend.position = "top",
      legend.box = "horizontal",
      plot.title.position = "plot"
    )

  print(maybe_plotly(add_xdate(p7))) }

Phân tích Code:

• Dùng pivot_longer để tái cấu trúc dữ liệu, chuẩn bị các thành tố DuPont cho việc vẽ biểu đồ.
• Vẽ ROE dưới dạng các cột trên trục tung chính bên trái.
• Vẽ ba thành tố DuPont (Biên lợi nhuận ròng, Vòng quay tài sản, Đòn bẩy tài chính) dưới dạng các đường trên trục tung phụ bên phải. Kỹ thuật này cho phép Ta so sánh các biến có thang đo khác nhau trên cùng một biểu đồ.

Kết quả:

• Các cột ROE có xu hướng biến động cùng chiều với đường Vòng quay tài sản.
• Biên lợi nhuận ròng và Đòn bẩy tài chính tương đối ổn định.
• Điều này cho thấy sự thay đổi trong ROE của công ty chủ yếu được quyết định bởi hiệu quả sử dụng tài sản, không phải bởi khả năng sinh lời hay việc sử dụng nợ.

5.2.3 ROA Decomposition: Scatter (AT vs Net margin)

if (all(c("asset_turnover","net_margin","Date") %in% names(df_plot))) {

  # Tính median để vẽ trục tham chiếu chiến lược
  med_x <- median(df_plot$asset_turnover, na.rm = TRUE)
  med_y <- median(df_plot$net_margin,     na.rm = TRUE)

  # Breaks/labels cho thanh màu thời gian
  t_min <- suppressWarnings(min(df_plot$Date, na.rm = TRUE))
  t_max <- suppressWarnings(max(df_plot$Date, na.rm = TRUE))
  yr_seq <- try(seq(as.Date(cut(t_min, "year")), as.Date(cut(t_max, "year")), by = "2 years"), silent = TRUE)
  if (inherits(yr_seq, "try-error") || length(yr_seq) < 2) {
    yr_seq <- unique(as.Date(c(t_min, t_max)))
  }

  # Bảng màu gradient (đẹp, dễ đọc)
  time_cols <- c("#2563EB", "#8B5CF6", "#F59E0B", "#EF4444")  # blue → violet → amber → coral

  p8 <- ggplot(df_plot, aes(x = asset_turnover, y = net_margin)) +
    # Nền cho vùng Net margin âm
    annotate("rect", xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = 0,
             fill = "#FEE2E2", alpha = 0.10) +

    # Halo trắng (lớp dưới) để điểm nổi bật trên nền
    geom_point(color = "white", size = 3.6, alpha = 0.8, na.rm = TRUE) +
    # Điểm màu theo thời gian (lớp trên)
    geom_point(aes(color = as.numeric(Date)), size = 2.2, alpha = 0.95, na.rm = TRUE) +

    # Đường LOESS mượt (xu hướng phi tuyến)
    geom_smooth(aes(color = NULL), method = "loess", se = FALSE, linewidth = 1.1, span = 0.6, color = "#111827") +
    # Đường hồi quy tuyến tính tổng quát (trade-off margin vs turnover)
    geom_smooth(aes(color = NULL), method = "lm", se = FALSE, linewidth = 0.9, linetype = "dashed", color = "#6B7280") +

    # Đường tham chiếu theo median (phân mảnh chiến lược)
    geom_vline(xintercept = med_x, linetype = "dotted", color = "#9CA3AF") +
    geom_hline(yintercept = med_y, linetype = "dotted", color = "#9CA3AF") +

    # Tỷ lệ & thang màu
    scale_x_continuous(labels = scales::number_format(accuracy = 0.01, suffix = "x"),
                       breaks = scales::breaks_pretty(n = 5), expand = expansion(mult = c(0.05, 0.08))) +
    scale_y_continuous(labels = pct_fmt,
                       breaks = scales::breaks_pretty(n = 5), expand = expansion(mult = c(0.05, 0.10))) +
    scale_color_gradientn(
      colours = time_cols,
      breaks  = as.numeric(yr_seq),
      labels  = format(yr_seq, "%Y"),
      name    = "Thời gian"
    ) +

    labs(
      title = "Phân rã ROA: Asset Turnover vs Net Margin",
      x = "Asset turnover (lần)",
      y = "Net margin",
      caption = cap_default
    ) +
    theme_pro() +
    theme(
      legend.position = "right",
      legend.box = "vertical",
      plot.title.position = "plot"
    ) +
    coord_cartesian(clip = "off")

  # Không dùng add_xdate vì trục X không phải Date
  print(maybe_plotly(p8))}

Phân tích Code:

• Tạo một biểu đồ phân tán (geom_point) với Asset turnover trên trục hoành và Net margin trên trục tung.
• Mã hóa thời gian vào màu sắc của các điểm. Màu xanh/tím là quá khứ, màu cam/đỏ là hiện tại. Điều này biến một biểu đồ tĩnh thành một chuỗi thời gian.
• Vẽ hai đường xu hướng: một đường hồi quy tuyến tính (lm) thể hiện mối quan hệ tổng thể, và một đường loess thể hiện xu hướng phi tuyến cục bộ.
• Thêm các đường tham chiếu tại giá trị trung vị của mỗi trục, chia biểu đồ thành bốn góc phần tư chiến lược.

Kết quả:

• Mỗi điểm là một quý, màu sắc cho thấy dòng thời gian.
• Các điểm dữ liệu di chuyển từ trái sang phải theo thời gian, cho thấy Vòng quay tài sản ngày càng cải thiện.
• Mối quan hệ tổng thể (đường gạch nối) là dương: khi công ty bán hàng hiệu quả hơn (turnover tăng), biên lợi nhuận cũng có xu hướng tăng.
• Tuy nhiên, đường xu hướng cục bộ (đường đậm) cho thấy một sự đánh đổi: ở mức Vòng quay tài sản rất cao (trên 0.6x), Biên lợi nhuận bắt đầu đi ngang hoặc giảm nhẹ. Điều này có thể do công ty phải giảm giá hoặc tăng chi phí để đạt được doanh số cao hơn.
• Hầu hết các điểm gần đây (màu cam/đỏ) đều nằm ở góc phần tư trên bên phải, thể hiện một giai đoạn hoạt động hiệu quả cả về biên lợi nhuận và vòng quay tài sản.

5.2.4 ROIC vs EBIT margin

df_plot2 <- df_plot
if (!("roic" %in% names(df_plot2)) || all(is.na(df_plot2$roic))) {
  n <- nrow(df_plot2)
  base_ic <- if ("ta" %in% names(df_plot2)) df_plot2$ta else rep(NA_real_, n)
  cash    <- if ("cash_eq" %in% names(df_plot2)) dplyr::coalesce(df_plot2$cash_eq, 0) else 0
  nibcl   <- if (all(c("cl","ap") %in% names(df_plot2))) dplyr::coalesce(df_plot2$cl - df_plot2$ap, 0) else 0
  ic_proxy <- if ("ic" %in% names(df_plot2)) df_plot2$ic else base_ic - cash - nibcl
  tax_eff <- if ("tax_rate" %in% names(df_plot2)) pmin(pmax(df_plot2$tax_rate, 0), 1) else rep(0.20, n)
  avg_ic  <- avg_lag1(ic_proxy)
  roic_proxy <- ifelse(is.finite(avg_ic) & avg_ic != 0 & "ebit" %in% names(df_plot2),
                       df_plot2$ebit * (1 - tax_eff) / avg_ic, NA_real_)
  df_plot2$roic <- if ("roic" %in% names(df_plot2)) dplyr::coalesce(df_plot2$roic, roic_proxy) else roic_proxy
}

# --- Vẽ ---
cols <- intersect(c("roic","operating_margin"), names(df_plot2))
if (length(cols) >= 1 && "Date" %in% names(df_plot2)) {

  rename_map <- c(roic = "ROIC", operating_margin = "EBIT margin")
  df_sel <- df_plot2 %>%
    dplyr::select(Date, dplyr::all_of(cols)) %>%
    dplyr::rename_with(~ rename_map[.x] %||% .x, .cols = -Date) %>%
    tidyr::pivot_longer(-Date, names_to = "metric", values_to = "value")

  # Nhãn quý gần nhất (dạng %)
  last_labels <- df_sel %>%
    dplyr::filter(!is.na(value)) %>%
    dplyr::group_by(metric) %>%
    dplyr::slice_max(order_by = Date, n = 1, with_ties = FALSE) %>%
    dplyr::ungroup() %>%
    dplyr::mutate(lbl = scales::percent(value, accuracy = 0.1))

  pal_line <- c("ROIC" = "#10B981", "EBIT margin" = "#2563EB", "WACC" = "#EF4444")
  has_repel <- requireNamespace("ggrepel", quietly = TRUE)

  has_wacc <- "wacc" %in% names(df_plot2)
  rib <- if (has_wacc && "roic" %in% names(df_plot2)) {
    df_plot2 %>% dplyr::select(Date, roic, wacc) %>%
      dplyr::filter(!is.na(roic), !is.na(wacc)) %>%
      dplyr::mutate(ymin = pmin(roic, wacc), ymax = pmax(roic, wacc))
  } else NULL

  p9 <- ggplot() +
    annotate("rect", xmin = -Inf, xmax = Inf, ymin = 0, ymax = Inf,
             fill = "#F8FAFC", alpha = 0.6) +
    { if (!is.null(rib)) list(
        geom_ribbon(data = rib, aes(Date, ymin = ymin, ymax = ymax, fill = "Spread"),
                    alpha = 0.15, show.legend = FALSE),
        scale_fill_manual(values = c("Spread" = "#10B981"))
      ) else NULL } +
    geom_line(data = df_sel, aes(Date, value, color = metric),
              linewidth = 2.2, alpha = 0.10, show.legend = FALSE) +
    geom_line(data = df_sel, aes(Date, value, color = metric),
              linewidth = 1.25, lineend = "round") +
    geom_point(data = df_sel, aes(Date, value, color = metric),
               size = 1.9, stroke = 0.3, show.legend = FALSE) +
    { if (has_wacc) list(
        geom_line(data = df_plot2, aes(Date, wacc, color = "WACC"),
                  linewidth = 1.1, linetype = "longdash"),
        geom_point(data = df_plot2, aes(Date, wacc, color = "WACC"),
                   size = 1.6, alpha = 0.9, show.legend = FALSE)
      ) else NULL } +
    geom_hline(yintercept = 0, linetype = "dotted", color = "#9CA3AF") +

    # ===== NHÃN % =====
    {
      if (has_repel) {
        ggrepel::geom_label_repel(
          data = last_labels,
          aes(Date, value, label = lbl, color = metric),
          fill = "white", label.size = 0, fontface = "bold",
          size = 3.1, segment.color = "#D1D5DB",
          box.padding = 0.25, point.padding = 0.2,
          max.overlaps = Inf, seed = 1, show.legend = FALSE
        )
      } else {
        geom_label(
          data = last_labels,
          aes(Date, value, label = lbl, color = metric),
          fill = "white", label.size = 0, fontface = "bold",
          size = 3.1, show.legend = FALSE
        )
      }
    } +

    scale_color_manual(values = pal_line, name = NULL) +
    scale_y_continuous(labels = pct_fmt,
                       breaks = scales::breaks_pretty(n = 5),
                       expand = expansion(mult = c(0.05, 0.16))) +
    labs(
      title = "ROIC & EBIT margin",
      x = NULL, y = "Tỷ lệ", caption = cap_default
    ) +
    theme_pro() +
    theme(legend.position = "top", legend.box = "horizontal", plot.title.position = "plot")

  print(maybe_plotly(add_xdate(p9)))}

Phân tích Code:

• Tự động ước tính ROIC nếu dữ liệu gốc bị thiếu. Điều này làm cho quy trình của Ta linh hoạt hơn.
• Dùng geom_line và geom_point để vẽ xu hướng của hai chỉ số này theo thời gian.

Kết quả:

• Đường EBIT Margin nằm trên đường ROIC. Khoảng cách này cho thấy Vòng quay vốn đầu tư của PNJ nhỏ hơn 1.
• Ta cần hơn 1 đồng vốn đầu tư để tạo ra 1 đồng doanh thu. Đây là đặc điểm của ngành bán lẻ hoặc phân phối.
• Cả hai chỉ số đều âm vào cuối năm 2021. Điều này xác nhận công ty đã lỗ từ hoạt động kinh doanh cốt lõi trong giai đoạn đó.

5.3 Hiệu quả & Vốn lưu động

5.3.1 Phân rã CCC

#  cột
need <- c("Date","ccc","dso","dio","dpo")
if (all(need %in% names(df_plot))) {

  # ===== Chuẩn bị dữ liệu + MA 4 quý =====
  df_ccc <- df_plot |> dplyr::arrange(Date) |>
    dplyr::mutate(ccc_ma4 = zoo::rollmean(ccc, k = 4, fill = NA, align = "right"))
  df_dso <- df_plot |> dplyr::arrange(Date) |>
    dplyr::transmute(Date, DSO = dso, MA4 = zoo::rollmean(dso, k = 4, fill = NA, align = "right"))
  df_dio <- df_plot |> dplyr::arrange(Date) |>
    dplyr::transmute(Date, DIO = dio, MA4 = zoo::rollmean(dio, k = 4, fill = NA, align = "right"))
  df_dpo <- df_plot |> dplyr::arrange(Date) |>
    dplyr::transmute(Date, DPO = dpo, MA4 = zoo::rollmean(dpo, k = 4, fill = NA, align = "right"))

  # ===== Màu sắc nhất quán =====
  col_ccc <- "#2563EB"   # royal blue
  col_ma  <- "#F59E0B"   # amber
  col_dso <- "#0EA5E9"   # sky
  col_dio <- "#8B5CF6"   # violet
  col_dpo <- "#EF4444"   # coral

  # ===== Helper panel gọn =====
  base_panel <- list(
    theme_pro(),
    theme(
      legend.position = "none",
      plot.title      = element_text(size = 11, face = "bold"),
      axis.text.x     = element_text(size = 8, angle = 45, hjust = 1),
      axis.text.y     = element_text(size = 8)
    ),
    scale_y_continuous(
      labels = scales::label_number(accuracy = 1, big.mark = ".", decimal.mark = ","),
      breaks = scales::breaks_pretty(n = 4),
      expand = expansion(mult = c(0.05, 0.10))
    )
  )

  # ===== Panel A: CCC tổng =====
  p_ccc <- ggplot(df_ccc, aes(Date, ccc)) +
    annotate("rect", xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = Inf,
             fill = "#F8FAFC", alpha = 0.65) +
    geom_hline(yintercept = 0, linetype = "dotted", color = "#9CA3AF") +
    geom_line(linewidth = 2.2, color = col_ccc, alpha = 0.12) +           # halo
    geom_line(color = col_ccc, linewidth = 1.15, lineend = "round") +
    geom_line(aes(y = ccc_ma4), color = col_ma, linewidth = 0.95, linetype = "longdash", na.rm = TRUE) +
    labs(title = "CCC", x = NULL, y = "Ngày", caption = cap_default) +
    base_panel

  # ===== Panel B: DSO =====
  p_dso <- ggplot(df_dso, aes(Date, DSO)) +
    annotate("rect", xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = Inf,
             fill = "#F8FAFC", alpha = 0.65) +
    geom_hline(yintercept = 0, linetype = "dotted", color = "#9CA3AF") +
    geom_line(linewidth = 2.2, color = col_dso, alpha = 0.12) +
    geom_line(color = col_dso, linewidth = 1.10) +
    geom_line(aes(y = MA4), color = col_ma, linewidth = 0.9, linetype = "longdash", na.rm = TRUE) +
    labs(title = "DSO (Kỳ thu tiền)", x = NULL, y = "Ngày") +
    base_panel

  # ===== Panel C: DIO =====
  p_dio <- ggplot(df_dio, aes(Date, DIO)) +
    annotate("rect", xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = Inf,
             fill = "#F8FAFC", alpha = 0.65) +
    geom_hline(yintercept = 0, linetype = "dotted", color = "#9CA3AF") +
    geom_line(linewidth = 2.2, color = col_dio, alpha = 0.12) +
    geom_line(color = col_dio, linewidth = 1.10) +
    geom_line(aes(y = MA4), color = col_ma, linewidth = 0.9, linetype = "longdash", na.rm = TRUE) +
    labs(title = "DIO (Kỳ tồn kho)", x = NULL, y = "Ngày") +
    base_panel

  # ===== Panel D: DPO =====
  p_dpo <- ggplot(df_dpo, aes(Date, DPO)) +
    annotate("rect", xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = Inf,
             fill = "#F8FAFC", alpha = 0.65) +
    geom_hline(yintercept = 0, linetype = "dotted", color = "#9CA3AF") +
    geom_line(linewidth = 2.2, color = col_dpo, alpha = 0.12) +
    geom_line(color = col_dpo, linewidth = 1.10) +
    geom_line(aes(y = MA4), color = col_ma, linewidth = 0.9, linetype = "longdash", na.rm = TRUE) +
    labs(title = "DPO (Kỳ thanh toán)", x = NULL, y = "Ngày") +
    base_panel

  # ===== Gộp 4 panel thành 1 hình =====
  if (requireNamespace("patchwork", quietly = TRUE)) {
    combo <- (p_ccc + p_dso) / (p_dio + p_dpo) +
      patchwork::plot_annotation(
        title = "Phân rã CCC — Đường nét đứt là MA4",
        theme = theme_pro() + theme(plot.title = element_text(size = 14, face = "bold"))
      )
    print(maybe_plotly(combo))
    maybe_save(combo, "11_ccc_4panel.png", w = 10, h = 7)
  } else if (requireNamespace("gridExtra", quietly = TRUE)) {
    gridExtra::grid.arrange(p_ccc, p_dso, p_dio, p_dpo, ncol = 2,
                            top = grid::textGrob("Phân rã CCC — Đường nét đứt là MA4",
                                                 gp = grid::gpar(fontsize = 14, fontface = "bold")))
  } else {
    # Fallback đơn giản nếu thiếu cả patchwork & gridExtra: in tuần tự
    print(p_ccc); print(p_dso); print(p_dio); print(p_dpo)
  }
}

Phân tích Code:

• Tính toán trung bình trượt 4 kỳ (zoo::rollmean) cho mỗi chỉ số. Đường trung bình trượt giúp làm mịn dữ liệu và làm nổi bật xu hướng dài hạn.
• Tạo ra bốn biểu đồ riêng biệt cho CCC, DSO, DIO và DPO.
• Dùng gói patchwork để ghép bốn biểu đồ này thành một lưới 2x2. patchwork cung cấp một cú pháp đơn giản (+ và /) để sắp xếp các biểu đồ.

Kết quả:

• Biểu đồ cho thấy CCC (ô trên bên trái) tăng đột biến vào cuối năm 2021.
• Nhìn vào các biểu đồ thành phần, Ta có thể xác định nguyên nhân. DIO (ô dưới bên trái) cũng có một đỉnh cực lớn tại cùng thời điểm.
• Điều này cho thấy vấn đề của công ty là do quản lý hàng tồn kho kém hiệu quả, không phải do thu tiền từ khách hàng (DSO).

5.3.2 Tỷ lệ Vònng quay

cols <- c("asset_turnover","inventory_turnover","receivables_turnover")
avail <- intersect(cols, names(df_plot))

if (length(avail) >= 2 && "Date" %in% names(df_plot)) {

  rename_map <- c(
    asset_turnover       = "T.sản",
    inventory_turnover   = "T.kho",
    receivables_turnover = "P.thu"
  )

  df_long <- df_plot |>
    dplyr::select(Date, dplyr::all_of(avail)) |>
    dplyr::rename_with(~ rename_map[.x] %||% .x, .cols = -Date) |>
    tidyr::pivot_longer(-Date, names_to = "Chỉ số", values_to = "Giá trị") |>
    dplyr::arrange(Date)

  df_ma <- df_long |>
    dplyr::group_by(`Chỉ số`) |>
    dplyr::mutate(`MA 4 quý` = zoo::rollmean(`Giá trị`, k = 4, fill = NA, align = "right")) |>
    dplyr::ungroup()

  last_lbls <- df_ma |>
    dplyr::filter(!is.na(`Giá trị`)) |>
    dplyr::group_by(`Chỉ số`) |>
    dplyr::slice_max(order_by = Date, n = 1, with_ties = FALSE) |>
    dplyr::ungroup() |>
    dplyr::mutate(
      x_lbl = as.Date(Date) + 90, 
      y_lbl = `Giá trị`,
      lbl   = paste0(scales::number(`Giá trị`, accuracy = 0.1, big.mark = ".", decimal.mark = ","), "x")
    )

  
  col_map <- c(
    "T.sản" = "#10B981",  # emerald
    "T.kho" = "#8B5CF6",  # violet
    "P.thu"= "#0EA5E9"   # sky
  )
  col_ma <- "#F59E0B"

  p12 <- ggplot(df_ma, aes(x = Date)) +
    annotate("rect", xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = Inf,
             fill = "#F8FAFC", alpha = 0.65) +
    geom_line(aes(y = `Giá trị`, color = `Chỉ số`), linewidth = 2.3, alpha = 0.12, show.legend = FALSE) +
    geom_line(aes(y = `Giá trị`, color = `Chỉ số`), linewidth = 1.15, lineend = "round") +
    geom_line(aes(y = `MA 4 quý`), color = col_ma, linewidth = 0.95, linetype = "longdash", na.rm = TRUE) +
    geom_hline(yintercept = 0, linetype = "dotted", color = "#9CA3AF") +
    geom_segment(data = last_lbls,
                 aes(x = Date, xend = x_lbl, y = y_lbl, yend = y_lbl, color = `Chỉ số`),
                 linewidth = 0.6, alpha = 0.6, show.legend = FALSE) +
    geom_label(data = last_lbls,
               aes(x = x_lbl, y = y_lbl, label = lbl, color = `Chỉ số`),
               fill = "white", label.size = 0, size = 3.1, show.legend = FALSE) +
    scale_color_manual(values = col_map, name = NULL) +
    scale_y_continuous(
      labels = scales::label_number(accuracy = 0.1, big.mark = ".", decimal.mark = ",", suffix = "x"),
      breaks = scales::breaks_pretty(n = 3),
      expand = expansion(mult = c(0.05, 0.12)),
      guide  = guide_axis(check.overlap = TRUE)
    ) +
    scale_x_date(date_labels = "%Y", date_breaks = "1 year",
                 expand = expansion(mult = c(0.02, 0.32))) +
    coord_cartesian(clip = "off") +
    labs(
      title = "Vòng quay",
      subtitle = "Dường nét đứt là MA4",
      x = NULL, y = NULL, caption = cap_default
    ) +
    theme_pro() +
    theme(
      legend.position    = "top",
      strip.placement    = "outside",
      strip.background   = element_rect(fill = "#EEF2FF", color = NA),
      strip.text         = element_text(face = "bold", margin = margin(b = 4, t = 4)),
      axis.text.x        = element_text(angle = 45, hjust = 1),
      axis.text.y        = element_text(margin = margin(r = 8)),
      panel.spacing.y    = grid::unit(16, "pt"),
      plot.margin        = margin(10, 46, 10, 24)
    ) +
    facet_wrap(~ `Chỉ số`, ncol = 1, scales = "free_y", strip.position = "left")

  print(maybe_plotly(p12))
  maybe_save(p12, "12_turnover_ratios.png")
}

Phân tích Code:

• Dùng pivot_longer để tái cấu trúc dữ liệu. ggplot2 yêu cầu định dạng này để tạo biểu đồ.
• Tính trung bình trượt 4 kỳ (zoo::rollmean). Đường trung bình trượt giúp làm mịn dữ liệu và làm nổi bật xu hướng.
• Dùng facet_wrap để tạo một biểu đồ nhỏ cho mỗi chỉ số.
• Dùng scales = "free_y". Tham số này là quan trọng nhất. Nó cho phép mỗi biểu đồ có trục tung riêng vì các chỉ số có thang đo rất khác nhau.

Kết quả:

• Vòng quay các khoản phải thu rất cao, khoảng 100 lần. Điều này cho thấy công ty thu tiền từ khách hàng rất nhanh.
• Vòng quay hàng tồn kho và tài sản thấp hơn nhiều, chỉ khoảng 0.5x đến 1.0x.
• Sự khác biệt lớn về thang đo này là lý do chính để sử dụng các biểu đồ riêng biệt. Nếu vẽ chung trên một trục, các chỉ số vòng quay thấp sẽ trông như một đường thẳng.

5.4 Dòng tiền

5.4.1 Waterfall CFO / CFI / CFF

if (all(c("cfo","cfi","cff","Date") %in% names(df_plot))) {

  # Data 
  df_cf <- df_plot |>
    dplyr::transmute(
      Date,
      `CFO (HĐKD)`      = cfo,
      `CFI (Đầu tư)`    = cfi,
      `CFF (Tài chính)` = cff
    ) |>
    tidyr::pivot_longer(-Date, names_to = "Dòng tiền", values_to = "Giá trị") |>
    dplyr::mutate(
      `Dòng tiền` = factor(`Dòng tiền`,
                           levels = c("CFI (Đầu tư)", "CFF (Tài chính)", "CFO (HĐKD)"))
    )

  # ΔCash theo kỳ
  net <- df_cf |>
    dplyr::group_by(Date) |>
    dplyr::summarise(net = sum(`Giá trị`, na.rm = TRUE), .groups = "drop")

  # ---- ĐỘ RỘNG CỘT THEO QUÝ  ----
  uq_dates <- sort(unique(df_cf$Date))
  step_days <- if (length(uq_dates) > 1) median(diff(uq_dates)) else 90
  bar_w <- as.numeric(step_days) * 0.75   # ~ 75% độ rộng mỗi quý

  # Nhãn ΔCash: chỉ hiển thị điểm nổi bật (top 20% | kỳ cuối)  tránh rối
  net <- net |>
    dplyr::mutate(
      keep   = abs(net) >= stats::quantile(abs(net), 0.8, na.rm = TRUE) | Date == max(Date),
      offset = 0.06 * max(abs(net), na.rm = TRUE),
      y_lbl  = net + ifelse(net >= 0, offset, -offset),
      lbl    = scales::number(net, accuracy = 0.1, big.mark = ".", decimal.mark = ","),
      col    = ifelse(net >= 0, "pos", "neg")
    )

  # Bảng màu
  fill_map <- c(
    "CFO (HĐKD)"      = "#16A34A",  # green-600
    "CFI (Đầu tư)"    = "#EF4444",  # red-500
    "CFF (Tài chính)" = "#6366F1"   # indigo-500
  )
  lbl_col  <- c(pos = "#059669", neg = "#DC2626")

  p18 <- ggplot(df_cf, aes(x = Date, y = `Giá trị`)) +
    annotate("rect", xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = Inf,
             fill = "#F8FAFC", alpha = 0.65) +
    geom_hline(yintercept = 0, color = "#9CA3AF", linetype = "dashed") +
    geom_col(aes(fill = `Dòng tiền`), width = bar_w, color = NA, alpha = 0.92) +
    geom_line(data = net, aes(x = Date, y = net),
              color = "#111827", linewidth = 1.1, inherit.aes = FALSE) +
    geom_point(data = net, aes(x = Date, y = net),
               color = "#111827", size = 1.9, inherit.aes = FALSE) +
    geom_label(
      data = subset(net, keep),
      aes(x = Date, y = y_lbl, label = lbl, color = col),
      fill = "white", label.size = 0, size = 3.1, fontface = "bold",
      show.legend = FALSE, inherit.aes = FALSE
    ) +
    scale_fill_manual(values = fill_map, name = NULL) +
    scale_color_manual(values = lbl_col, guide = "none") +
    scale_y_continuous(labels = num_fmt, expand = expansion(mult = c(0.08, 0.12))) +
    scale_x_date(date_labels = "%Y", date_breaks = "1 year",
                 expand = expansion(mult = c(0.02, 0.04))) +
    coord_cartesian(clip = "off") +
    labs(
      title = "Thác nước Dòng tiền (CFO / CFI / CFF)",
      subtitle = "Cột theo quý (rộng 75% kỳ)|Đường đen: ΔCash|Nhãn chỉ hiển thị kỳ nổi bật.",
      x = NULL, y = "Ngàn Tỷ", caption = cap_default
    ) +
    theme_pro() +
    theme(
      legend.position = "top",
      axis.text.x = element_text(angle = 45, hjust = 1),
      panel.grid.major.x = element_blank(),
      plot.margin = margin(10, 28, 10, 10)
    )

  print(maybe_plotly(p18))  # nếu plotly làm nhãn trùng, đổi tạm thành: print(p18)
  maybe_save(p18, "18_cashflow_waterfall.png")
}

Phân tích Code:

• Dùng factor để sắp xếp thứ tự các dòng tiền. Điều này đảm bảo các cột xếp chồng được vẽ một cách logic.
• Tính toán dòng tiền ròng (net) bằng cách cộng ba dòng tiền thành phần.
• Kết hợp geom_col để vẽ các thành phần và geom_line để vẽ dòng tiền ròng. Kỹ thuật này cho thấy cả nguyên nhân và kết quả.

Kết quả:

*   Đầu năm 2022, dòng tiền ròng đạt đỉnh do CFO rất lớn.
*   Cuối năm 2022, dòng tiền ròng giảm mạnh do CFO và CFI cùng âm.

Kết luận: Mô hình kinh doanh của công ty lành mạnh, với dòng tiền chính đến từ hoạt động kinh doanh.

5.4.2 Chất lượng Lợi nhuận (CFO vs NI)

if (all(c("Date","cfo","ni") %in% names(df_plot))) {

  # hệ số trục phụ an toàn
  s <- safe_coef(df_plot$cfo, df_plot$ni)

  # độ rộng cột theo khoảng cách quý
  uq  <- sort(unique(df_plot$Date))
  step_days <- if (length(uq) > 1) median(diff(uq)) else 90
  bar_w <- as.numeric(step_days) * 0.75

  df_cfo <- df_plot |>
    dplyr::select(Date, cfo, ni) |>
    dplyr::mutate(
      `CFO ký hiệu` = dplyr::case_when(cfo > 0 ~ "CFO (+)", cfo < 0 ~ "CFO (-)", TRUE ~ "CFO (0)"),
      diverge = dplyr::if_else(sign(cfo) * sign(ni) == -1, TRUE, FALSE, missing = FALSE)
    )

  # điểm cuối cho nhãn NI (trục phụ)
  last_ni <- df_cfo |>
    dplyr::filter(!is.na(ni)) |>
    dplyr::slice_tail(n = 1) |>
    dplyr::mutate(
      x_lbl = Date + step_days * 0.7,
      y_lbl = ni * s,
      lbl   = paste0("NI: ", scales::number(ni, accuracy = 0.1, big.mark=".", decimal.mark=",")))
  
  fill_map <- c("CFO (+)"="#16A34A","CFO (-)"="#EF4444","CFO (0)"="#A3A3A3")
  line_col <- "#1D4ED8"  # xanh dương đậm cho NI

  p19 <- ggplot(df_cfo, aes(x = Date)) +
    # nền hồng các quý phân kỳ CFO vs NI
    geom_rect(
      data = dplyr::filter(df_cfo, diverge),
      aes(xmin = Date - step_days*0.5, xmax = Date + step_days*0.5,
          ymin = -Inf, ymax = Inf),
      inherit.aes = FALSE, fill = "#FDE2E2", alpha = 0.35
    ) +
    # đường zero
    geom_hline(yintercept = 0, linetype = "dashed", color = "#9CA3AF") +
    # cột CFO
    geom_col(aes(y = cfo, fill = `CFO ký hiệu`), width = bar_w, alpha = 0.92, color = NA) +
    # đường & điểm NI (được scale lên trục trái rồi trả về bằng sec.axis)
    geom_line(aes(y = ni * s, color = "NI (trục phụ)", group = 1), linewidth = 1.25) +
    geom_point(aes(y = ni * s, color = "NI (trục phụ)"), size = 1.9) +
    # nhãn NI ở kỳ cuối
    geom_label(
      data = last_ni,
      aes(x = x_lbl, y = y_lbl, label = lbl),
      inherit.aes = FALSE, size = 3.1, label.size = 0,
      fill = "white", color = line_col, fontface = "bold"
    ) +
    scale_fill_manual(values = fill_map, name = NULL) +
    scale_color_manual(values = c("NI" = line_col), name = NULL) +
    scale_y_continuous(
      name = "CFO (Ngàn Tỷ)", labels = num_fmt,
      sec.axis = sec_axis(~ . / s, name = "Net Income (Ngàn Tỷ)", labels = num_fmt),
      expand = expansion(mult = c(0.08, 0.12))
    ) +
    scale_x_date(date_breaks = "1 year", date_labels = "%Y",
                 expand = expansion(mult = c(0.02, 0.04))) +
    coord_cartesian(clip = "off") +
    labs(
      title = "Chất lượng Lợi nhuận: CFO vs Net Income",
      x = NULL, caption = cap_default
    ) +
    theme_pro() +
    theme(
      legend.position = "top",
      axis.text.x = element_text(angle = 45, hjust = 1),
      panel.grid.major.x = element_blank(),
      plot.margin = margin(10, 28, 10, 10)
    )

  print(maybe_plotly(p19))  # Nếu tooltip gây rối, dùng print(p19)
  maybe_save(p19, "19_quality_of_earnings.png")
}

Phân tích Code:

• Tạo một biến diverge để xác định các kỳ có sự phân kỳ giữa CFO và Lợi nhuận ròng. Logic này dùng tích của hàm sign() để phát hiện các trường hợp hai chỉ số trái dấu.
• Dùng geom_rect để tô màu nền cho các kỳ có sự phân kỳ. Đây là một cảnh báo trực quan mạnh mẽ.
• Dùng geom_col cho CFO và tô màu xanh/đỏ tùy theo giá trị dương/âm.
• Dùng geom_line và kỹ thuật trục phụ để vẽ Lợi nhuận ròng.

Kết quả:

• Nhìn chung, xu hướng của CFO và Lợi nhuận ròng đồng pha với nhau.
• Tuy nhiên, các vùng màu hồng cho thấy có nhiều kỳ công ty báo lãi nhưng dòng tiền hoạt động lại âm. Đây là một cảnh báo về chất lượng lợi nhuận.
• Ngay cả khi cùng dương, CFO thường thấp hơn Lợi nhuận ròng, cho thấy khả năng chuyển đổi lợi nhuận thành tiền mặt cần được cải thiện.

5.4.3 Tỷ lệ CFO/NI

if (all(c("Date","cfo_ni") %in% names(df_plot))) {

  # kích thước cột mốc theo khoảng cách quý (dùng cho nhãn lệch)
  uq  <- sort(unique(df_plot$Date))
  step_days <- if (length(uq) > 1) median(diff(uq)) else 90

  # dải nền
  min_y <- suppressWarnings(min(df_plot$cfo_ni, na.rm = TRUE))
  max_y <- suppressWarnings(max(df_plot$cfo_ni, na.rm = TRUE))
  max_y <- if (!is.finite(max_y)) 2 else max(max_y, 2)

  # điểm cuối để gắn nhãn
  last_pt <- df_plot |>
    dplyr::filter(!is.na(cfo_ni)) |>
    dplyr::slice_tail(n = 1) |>
    dplyr::mutate(
      x_lbl = Date + step_days*0.7,
      y_lbl = cfo_ni,
      lbl   = paste0(scales::number(cfo_ni, accuracy = 0.01, big.mark=".", decimal.mark=","), "×")
    )

  line_col  <- "#0EA5E9"  # cyan-600
  loess_col <- "#F59E0B"  # amber-500

  p20 <- ggplot(df_plot, aes(x = Date, y = cfo_ni, group = 1)) +
    # nền: yếu (<1) đỏ nhạt, khỏe (>=1) xanh nhạt
    annotate("rect", xmin = -Inf, xmax = Inf, ymin = 1, ymax = Inf,
             fill = "#ECFDF5", alpha = 0.45) +
    annotate("rect", xmin = -Inf, xmax = Inf, ymin = 0, ymax = 1,
             fill = "#FDE2E2", alpha = 0.45) +
    # nếu có phần <0, tô đỏ đậm hơn
    { if (is.finite(min_y) && min_y < 0)
        annotate("rect", xmin = -Inf, xmax = Inf, ymin = min_y, ymax = 0,
                 fill = "#FECACA", alpha = 0.45) } +
    # đường tham chiếu
    geom_hline(yintercept = 0, color = "#9CA3AF", linetype = "dotted") +
    geom_hline(yintercept = 1, color = "#6B7280", linetype = "dashed") +
    geom_hline(yintercept = 2, color = "#CBD5E1", linetype = "dotted") +
    # chuỗi chính + LOESS xu hướng
    geom_line(color = line_col, linewidth = 1.2) +
    geom_point(color = line_col, size = 1.9) +
    geom_smooth(method = "loess", se = FALSE, color = loess_col, linewidth = 1) +
 
    geom_label(
      data = last_pt,
      aes(x = x_lbl, y = y_lbl, label = lbl),
      inherit.aes = FALSE, size = 3.1, label.size = 0,
      fill = "white", color = line_col, fontface = "bold"
    ) +
    scale_y_continuous(labels = qty_fmt, expand = expansion(mult = c(0.08, 0.12))) +
    scale_x_date(date_breaks = "1 year", date_labels = "%Y",
                 expand = expansion(mult = c(0.02, 0.04))) +
    coord_cartesian(clip = "off") +
    labs(
      title = "Tỷ lệ CFO / NI",
      subtitle = "Nền đỏ: Tỷ lệ < 1X | Đường vàng: LOESS xu hướng.",
      x = NULL, y = "Lần", caption = cap_default
    ) +
    theme_pro() +
    theme(
      panel.grid.major.x = element_blank(),
      axis.text.x = element_text(angle = 45, hjust = 1),
      plot.margin = margin(10, 28, 10, 10)
    )

  print(maybe_plotly(p20))   
  maybe_save(p20, "20_cfo_ni_ratio.png")
}

Phân tích Code:

• Dùng annotate("rect", ...) để tạo các vùng nền màu xanh/hồng/đỏ. Các vùng này cung cấp một bối cảnh trực quan, giúp người xem đánh giá ngay lập tức mức độ “khỏe mạnh” của chỉ số.
• Dùng geom_hline để vẽ các đường tham chiếu tại các ngưỡng quan trọng (0 và 1).
• Kết hợp geom_line để vẽ dữ liệu gốc và geom_smooth để vẽ một đường xu hướng dài hạn. Đường xu hướng giúp Ta nhìn xuyên qua các biến động ngắn hạn.

Kết quả:

• Khả năng chuyển đổi lợi nhuận thành tiền mặt của công ty rất không ổn định, thể hiện qua sự biến động mạnh của đường màu xanh.
• Đường xu hướng dài hạn (màu vàng) cho thấy chất lượng lợi nhuận đã cải thiện trong giai đoạn 2019-2022 nhưng đang có dấu hiệu suy giảm trở lại.
• Phần lớn thời gian, tỷ lệ này nằm dưới mức 1 (vùng màu hồng). Điều này xác nhận rằng chất lượng lợi nhuận là một điểm yếu của công ty.

5.5 Nội suy tuyến tính

5.5.1 Ma trận Tương quan (Heatmap)

key_cols <- intersect(
  c("revenue_yoy","net_margin","roe","ccc","debt_to_equity","fcf_margin","asset_turnover"),
  names(df_plot)
)

if (length(key_cols) >= 3) {
  sub <- df_plot |>
    dplyr::select(dplyr::all_of(key_cols)) |>
    dplyr::mutate(dplyr::across(dplyr::everything(), as.numeric))

  cm <- cor(sub, use = "pairwise.complete.obs")
  cm[is.na(cm)] <- 0

  # Sắp xếp theo phân cụm dựa trên |cor|
  ord <- hclust(as.dist(1 - abs(cm)))$order
  cm_ord <- cm[ord, ord]

  # Chỉ hiển thị tam giác dưới
  cm_ord[upper.tri(cm_ord, diag = FALSE)] <- NA
  dfc <- as.data.frame(as.table(cm_ord))
  names(dfc) <- c("Var1","Var2","Corr")
  dfc <- dplyr::filter(dfc, !is.na(Corr))
  dfc$Var1 <- factor(dfc$Var1, levels = rownames(cm_ord))
  dfc$Var2 <- factor(dfc$Var2, levels = colnames(cm_ord))

  p22 <- ggplot(dfc, aes(x = Var2, y = Var1, fill = Corr)) +
    # Ô vuông + lưới trắng mảnh
    geom_tile(width = .95, height = .95, color = "white", linewidth = .6) +
    # Nhãn số; màu chữ tự động: trắng khi |Corr| lớn
    geom_text(
      aes(
        label = scales::number(Corr, accuracy = 0.01, decimal.mark = ","),
        color = ifelse(abs(Corr) >= 0.5, "hi", "lo")
      ),
      size = 3.2, fontface = "bold"
    ) +
    # Palette phân kỳ (đỏ–trắng–xanh), cố định [-1,1]
    scale_fill_gradient2(
      low = "#EF4444", mid = "#F8FAFC", high = "#22C55E",
      midpoint = 0, limits = c(-1, 1), name = "Tương quan"
    ) +
    scale_color_manual(values = c(hi = "white", lo = "#374151"), guide = "none") +
    coord_fixed() +
    labs(
      title = "Ma trận tương quan ",
      x = NULL, y = NULL, caption = cap_default
    ) +
    theme_pro() +
    theme(
      legend.position = "right",
      axis.text.x = element_text(angle = 45, hjust = 1),
      panel.grid = element_blank(),
      plot.margin = margin(10, 20, 10, 10)
    )

  print(p22)                  # hoặc maybe_plotly(p22) nếu muốn tương tác
  maybe_save(p22, "22_correlation_heatmap.png")
}

Phân tích Code:

• Dùng hàm cor() để tính ma trận tương quan giữa các biến.
• Sử dụng kỹ thuật Phân cụm theo thứ bậc (hclust) để sắp xếp lại ma trận. Việc này nhóm các biến có tương quan cao lại gần nhau, làm nổi bật các cụm quan hệ.
• Dùng geom_tile để vẽ bản đồ nhiệt.
• Dùng scale_fill_gradient2, một thang màu phân kỳ. Màu xanh cho tương quan thuận, màu đỏ cho tương quan nghịch, và màu trắng cho giá trị gần 0.

Kết quả:

• Cụm Lợi nhuận & Hiệu quả: ROE có tương quan thuận rất mạnh với Biên lợi nhuận ròng và Vòng quay tài sản. Điều này xác nhận kết quả từ phân tích DuPont.
• Mối quan hệ Nghịch chiều mạnh nhất: Chu kỳ chuyển đổi tiền mặt (CCC) có tương quan nghịch rất mạnh với Biên lợi nhuận ròng và Vòng quay tài sản. Khi công ty quản lý vốn lưu động hiệu quả hơn (CCC thấp hơn), lợi nhuận và hiệu quả của họ cao hơn.
• Tăng trưởng và Đòn bẩy: Tăng trưởng doanh thu không có tương quan mạnh với lợi nhuận. Đòn bẩy tài chính có tương quan nghịch với các chỉ số hiệu quả.

5.5.2 Phân rã STL (Revenue hoặc NI)

series_name <- if ("revenue" %in% names(df_plot)) "revenue" else if ("ni" %in% names(df_plot)) "ni" else NA_character_

if (!is.na(series_name) && sum(!is.na(df_plot[[series_name]])) >= 8) {
  y0 <- suppressWarnings(min(df_plot$yr, na.rm = TRUE))
  q0 <- df_plot$qtr[which.min(df_plot$Date)]
  if (!is.finite(y0) || is.na(y0)) y0 <- 2000
  if (is.na(q0)) q0 <- 1

  ts_obj <- stats::ts(df_plot[[series_name]], frequency = 4, start = c(y0, q0))
  fit <- try(stats::stl(ts_obj, s.window = "periodic", robust = TRUE), silent = TRUE)

  if (!inherits(fit, "try-error")) {
    comp_wide <- dplyr::tibble(
      Date      = df_plot$Date,
      observed  = as.numeric(fit$time.series[, "trend"] + fit$time.series[, "seasonal"] + fit$time.series[, "remainder"]),
      trend     = as.numeric(fit$time.series[, "trend"]),
      seasonal  = as.numeric(fit$time.series[, "seasonal"]),
      remainder = as.numeric(fit$time.series[, "remainder"])
    )

    # dữ liệu dài + panel
    comp <- comp_wide |>
      tidyr::pivot_longer(-Date, names_to = "name", values_to = "value") |>
      dplyr::mutate(
        panel = dplyr::recode(name,
          observed  = "Observed & Trend",
          trend     = "Observed & Trend",
          seasonal  = "Seasonal",
          remainder = "Remainder"
        ),
        sign_season = dplyr::case_when(name == "seasonal" & value >= 0 ~ "Dương",
                                       name == "seasonal" & value <  0 ~ "Âm",
                                       TRUE ~ NA_character_)
      )

    # nhãn Trend kỳ gần nhất
    last_trend <- comp |>
      dplyr::filter(name == "trend", !is.na(value)) |>
      dplyr::slice_tail(n = 1) |>
      dplyr::mutate(lbl = scales::number(value, accuracy = 0.1, big.mark=".", decimal.mark=","))

    # màu pro
    col_obs <- "#0EA5E9"  # cyan
    col_trd <- "#F59E0B"  # amber
    col_rem <- "#8B5CF6"  # violet
    fill_pos <- "#DCFCE7" # green-100
    fill_neg <- "#FEE2E2" # red-100

    p23 <- ggplot(comp, aes(x = Date)) +
      # Seasonal ribbon (theo dấu)
      geom_ribbon(
        data = dplyr::filter(comp, name == "seasonal"),
        aes(ymin = pmin(value, 0), ymax = pmax(value, 0), fill = sign_season),
        alpha = 0.6, color = NA
      ) +
      # đường zero cho Seasonal & Remainder
      geom_hline(
        data = subset(comp, panel %in% c("Seasonal","Remainder")) |> dplyr::distinct(panel),
        aes(yintercept = 0), linetype = "dashed", color = "#9CA3AF"
      ) +
      # Observed
      geom_line(
        data = dplyr::filter(comp, name == "observed"),
        aes(y = value, color = "Observed"), linewidth = 0.9
      ) +
      # Trend
      geom_line(
        data = dplyr::filter(comp, name == "trend"),
        aes(y = value, color = "Trend"), linewidth = 1.25
      ) +
      # Remainder (điểm + đường mảnh)
      geom_line(
        data = dplyr::filter(comp, name == "remainder"),
        aes(y = value, color = "Remainder"), linewidth = 0.7, alpha = 0.8
      ) +
      geom_point(
        data = dplyr::filter(comp, name == "remainder"),
        aes(y = value, color = "Remainder"), size = 1.2, alpha = 0.9
      ) +
      # nhãn Trend
      geom_label(
        data = last_trend,
        aes(x = Date + 20, y = value, label = lbl),
        inherit.aes = FALSE, size = 3.1, label.size = 0,
        fill = "white", color = col_trd, fontface = "bold"
      ) +
      facet_wrap(~ panel, ncol = 1, scales = "free_y") +
      scale_fill_manual(values = c("Dương" = fill_pos, "Âm" = fill_neg), guide = "none") +
      scale_color_manual(values = c("Observed" = col_obs, "Trend" = col_trd, "Remainder" = col_rem), name = NULL) +
      scale_y_continuous(labels = num_fmt, breaks = scales::breaks_pretty(n = 3),
                         expand = expansion(mult = c(0.08, 0.12))) +
      scale_x_date(date_breaks = "1 year", date_labels = "%Y",
                   expand = expansion(mult = c(0.02, 0.04))) +
      coord_cartesian(clip = "off") +
      labs(
        title = paste0("Phân rã STL: ", toupper(series_name)),
        x = NULL, y = NULL, caption = cap_default
      ) +
      theme_pro() +
      theme(
        legend.position = "top",
        panel.grid.major.x = element_blank(),
        axis.text.x = element_text(angle = 45, hjust = 1),
        plot.margin = margin(10, 24, 10, 10)
      )

    print(p23)                       # hoặc maybe_plotly(p23) nếu muốn tương tác
    maybe_save(p23, "23_stl_decomposition.png", w = 9, h = 8)
  }
}

Phân tích Code:

• Chuyển đổi dữ liệu thành một đối tượng chuỗi thời gian (ts) với tần suất 4 kỳ mỗi năm. Đây là yêu cầu của hàm stl.
• Áp dụng thuật toán stl để phân rã chuỗi thời gian thành ba thành phần: xu hướng, mùa vụ và phần dư.
• Dùng facet_wrap để vẽ mỗi thành phần trên một biểu đồ nhỏ riêng biệt.
• Dùng scales = "free_y". Điều này là cần thiết vì mỗi thành phần có một thang đo khác nhau.

Kết quả:

• Xu hướng (Trend): Đường màu vàng trong panel đầu tiên cho thấy sự tăng trưởng dài hạn đã được làm mịn, loại bỏ các biến động theo quý.
• Mùa vụ (Seasonal): Panel cuối cùng cho thấy một mẫu hình lặp lại hàng năm, với các quý mạnh và quý yếu rõ ràng.
• Phần dư (Remainder): Panel ở giữa làm nổi bật các sự kiện bất thường. Cú sụt giảm mạnh vào cuối năm 2021 là một sự kiện ngoại lệ, không phải do xu hướng hay mùa vụ.

5.5.3 Scatter Matrix (P&L chính)

cols <- intersect(c("revenue","gp","ebit","ni"), names(df_plot))
if (length(cols) >= 3) {

  # Dữ liệu & nhãn cột
  df_pairs <- df_plot[, cols, drop = FALSE]
  vi_labels <- c(revenue = "Doanh thu", gp = "Ln gộp", ebit = "EBIT", ni = "Ln ròng")
  colnames(df_pairs) <- vi_labels[cols]

  # Panel trên: hệ số tương quan có nền theo độ mạnh (đỏ âm, xanh dương)
  upper_fun <- function(data, mapping, ...){
    x <- as.numeric(rlang::eval_tidy(mapping$x, data))
    y <- as.numeric(rlang::eval_tidy(mapping$y, data))
    c <- suppressWarnings(stats::cor(x, y, use = "pairwise.complete.obs"))
    c <- ifelse(is.finite(c), c, NA_real_)

    fill_fun <- scales::col_numeric(
      palette  = c("#EF4444", "#F8FAFC", "#22C55E"),
      domain   = c(-1, 1),
      na.color = "#E5E7EB"
    )
    bg  <- fill_fun(c)
    txt <- if (!is.na(c) && abs(c) >= 0.5) "white" else "#111827"

    ggplot() +
      annotate("rect", xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = Inf, fill = bg) +
      annotate("text", x = 0.5, y = 0.5,
               label = scales::number(c, accuracy = 0.01, decimal.mark = ","),
               colour = txt, size = 5, fontface = "bold") +
      theme_void()
  }

  # Panel dưới: scatter + đường hồi quy
  lower_fun <- function(data, mapping, ...){
    ggplot(data = data, mapping = mapping) +
      geom_point(alpha = 0.6, size = 1.6, color = "#0EA5E9") +
      geom_smooth(method = "lm", se = FALSE, linewidth = 0.9, color = "#F59E0B") +
      theme_minimal(base_size = 10) +
      theme(panel.grid.minor = element_blank(),
            panel.grid.major = element_line(color = "#ECEFF4"))
  }

  # Đường chéo: mật độ (density)
  diag_fun <- GGally::wrap("densityDiag", alpha = 0.6, fill = "#8B5CF6", adjust = 1)

  p24 <- GGally::ggpairs(
    df_pairs,
    upper = list(continuous = upper_fun),
    lower = list(continuous = lower_fun),
    diag  = list(continuous = diag_fun)
  ) +
    theme_pro() +
    theme(
      strip.text       = element_text(face = "bold", size = 10),
      panel.spacing    = unit(0.6, "lines"),
      axis.text.x      = element_text(size = 8, angle = 45, hjust = 1),
      axis.text.y      = element_text(size = 8),
      plot.title       = element_text(size = 14),
      plot.caption     = element_text(size = 9),
      panel.grid.major = element_blank()
    ) +
    labs(
      title   = "Ma trận phân tán ",
      caption = cap_default )
  print(p24)
  if (save_plots) ggsave(file.path('figs', '24_pairs_plot.png'), p24, width = 9, height = 9, dpi = 300)
}

Phân tích Code:

• Dùng hàm GGally::ggpairs để tạo một lưới biểu đồ N x N.
• Tùy chỉnh từng khu vực của ma trận:
  • Tam giác trên: Hiển thị hệ số tương quan dưới dạng bản đồ nhiệt.
  • Tam giác dưới: Hiển thị biểu đồ phân tán với một đường hồi quy tuyến tính.
  • Đường chéo: Hiển thị biểu đồ mật độ để xem phân phối của từng biến.

Kết quả:

• Phân phối (Đường chéo): Các biến đều có phân phối lệch phải. Điều này có nghĩa là có một vài quý với doanh thu và lợi nhuận rất cao.
• Tương quan (Tam giác trên): Tất cả các chỉ số lợi nhuận đều có tương quan thuận rất mạnh với nhau. Khi doanh thu tăng, các loại lợi nhuận khác cũng tăng theo.
• Mối quan hệ Tuyến tính (Tam giác dưới): Các điểm dữ liệu nằm rất sát đường hồi quy. Điều này xác nhận mối quan hệ giữa chúng là tuyến tính mạnh mẽ, không có các điểm ngoại lệ rõ rệt.

5.5.4 Doanh thu Rolling 4Q

if (all(c("Date","revenue") %in% names(df_plot))) {
  df_roll <- df_plot |>
    dplyr::mutate(
      revenue_4Q = zoo::rollsum(revenue, k = 4, fill = NA, align = "right"),
      sign_4Q    = dplyr::case_when(
        is.na(revenue_4Q) ~ NA_character_,
        revenue_4Q >= 0   ~ "≥ 0",
        TRUE              ~ "< 0"
      )
    )

  if (sum(!is.na(df_roll$revenue_4Q)) >= 2) {
    # bước thời gian để canh nhãn
    uq <- sort(unique(df_roll$Date))
    step_days <- if (length(uq) > 1) median(diff(uq)) else 90

    last_pt <- df_roll |>
      dplyr::filter(!is.na(revenue_4Q)) |>
      dplyr::slice_tail(n = 1) |>
      dplyr::mutate(
        x_lbl = Date + step_days*0.7,
        lbl   = paste0("4Q: ", scales::number(revenue_4Q, accuracy = 0.1, big.mark=".", decimal.mark=","))
      )

    col_line  <- "#0EA5E9"  # cyan-600
    col_loess <- "#F59E0B"  # amber-500

    p26 <- ggplot(df_roll, aes(x = Date)) +
      # ribbon phân cực theo dấu của rolling 4Q
      geom_ribbon(
        aes(ymin = pmin(revenue_4Q, 0), ymax = pmax(revenue_4Q, 0), fill = sign_4Q),
        alpha = 0.55, color = NA
      ) +
      # đường zero mảnh
      geom_hline(yintercept = 0, linetype = "dotted", color = "#9CA3AF") +
      # đường rolling 4Q + điểm
      geom_line(aes(y = revenue_4Q), color = col_line, linewidth = 1.4) +
      geom_point(aes(y = revenue_4Q), color = col_line, size = 1.7) +
      # xu hướng loess
      geom_smooth(aes(y = revenue_4Q), method = "loess", se = FALSE, color = col_loess, linewidth = 1) +
      # nhãn kỳ mới nhất
      geom_label(
        data = last_pt,
        aes(x = x_lbl, y = revenue_4Q, label = lbl),
        inherit.aes = FALSE, size = 3.1, label.size = 0,
        fill = "white", color = col_line, fontface = "bold"
      ) +
      scale_fill_manual(values = c("≥ 0" = "#DCFCE7", "< 0" = "#EF4444"), guide = "none") +
      scale_y_continuous(labels = num_fmt, expand = expansion(mult = c(0.08, 0.12))) +
      scale_x_date(date_breaks = "1 year", date_labels = "%Y",
                   expand = expansion(mult = c(0.02, 0.04))) +
      coord_cartesian(clip = "off") +
      labs(
        title = "Doanh thu Rolling 4Q (TTM)",
        subtitle = "Ribbon xanh/đỏ theo dấu|Đường vàng là LOESS xu hướng",
        x = NULL, y = "Ngàn Tỷ", caption = cap_default
      ) +
      theme_pro() +
      theme(
        panel.grid.major.x = element_blank(),
        axis.text.x = element_text(angle = 45, hjust = 1),
        plot.margin = margin(10, 24, 10, 10)
      )

    print(maybe_plotly(p26))   # hoặc print(p26) nếu cần tĩnh tuyệt đối
    maybe_save(p26, "26_revenue_rolling4Q.png")
  }
}

Phân tích Code:

• Dùng zoo::rollsum(..., k = 4, ...) để tính tổng doanh thu của 4 quý gần nhất. Thao tác này tạo ra dữ liệu Trailing Twelve Months (TTM).
• Dùng geom_ribbon để tô màu vùng dưới đường doanh thu TTM. Kỹ thuật này tạo cảm giác về quy mô và làm cho sự tăng trưởng trở nên ấn tượng hơn.
• Kết hợp geom_line (dữ liệu TTM) và geom_smooth (xu hướng của TTM). geom_smooth hoạt động như một lớp làm mịn thứ hai, giúp xác định sự thay đổi trong tốc độ tăng trưởng.

Kết quả:

• Biểu đồ này mượt mà hơn nhiều so với dữ liệu quý gốc. Các biến động mùa vụ đã được loại bỏ, giúp Ta tập trung vào xu hướng tăng trưởng cốt lõi.
• Xu hướng tăng trưởng rõ ràng từ năm 2018.
• Có một giai đoạn tăng tốc mạnh mẽ từ giữa năm 2022 đến 2024.
• Dữ liệu TTM là một tiêu chuẩn trong tài chính. Nó cập nhật hơn dữ liệu năm nhưng ổn định hơn dữ liệu quý.

5.5.5 Biên lợi nhuận

cols <- intersect(c("gross_margin","operating_margin","net_margin"), names(df_plot))
if (length(cols) >= 2) {

  dfm <- df_plot |>
    dplyr::select(Date, dplyr::all_of(cols)) |>
    tidyr::pivot_longer(-Date, names_to = "Metric", values_to = "Value") |>
    dplyr::mutate(
      Metric = dplyr::recode(Metric,
        gross_margin     = "Biên gộp",
        operating_margin = "Biên EBIT",
        net_margin       = "Biên ròng"
      )
    )

  uq <- sort(unique(dfm$Date))
  step_days <- if (length(uq) > 1) stats::median(diff(uq)) else 90

  last_pts <- dfm |>
    dplyr::filter(!is.na(Value)) |>
    dplyr::group_by(Metric) |>
    dplyr::slice_tail(n = 1) |>
    dplyr::ungroup() |>
    dplyr::mutate(
      x_lbl = Date + step_days*0.9,
      lbl   = paste0(Metric, ": ",
                     scales::percent(Value, accuracy = 0.1, big.mark=".", decimal.mark=","))
    )

  pal_margin <- c(
    "Biên ròng" = "#8B5CF6",
    "Biên EBIT" = "#10B981",
    "Biên gộp"  = "#0EA5E9"
  )

  base <- ggplot(dfm, aes(x = Date, y = Value, color = Metric, group = Metric)) +
    annotate("rect", xmin = -Inf, xmax = Inf, ymin = 0, ymax = Inf,
             fill = "#EEFDF3", alpha = 0.30) +
    annotate("rect", xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = 0,
             fill = "#F5EEFF", alpha = 0.30) +
    geom_line(linewidth = 2.2, alpha = 0.10, lineend = "round") +
    geom_line(linewidth = 1.25, lineend = "round") +
    # ==== LOESS ====
    geom_smooth(se = FALSE, method = "loess", linewidth = 1, linetype = "dashed") +
    # ===============
    scale_color_manual(values = pal_margin) +
    scale_y_continuous(labels = pct_fmt, expand = expansion(mult = c(0.08, 0.12))) +
    scale_x_date(date_breaks = "1 year", date_labels = "%Y",
                 expand = expansion(mult = c(0.02, 0.18))) +
    labs(
      title = "Biên lợi nhuận (LOESS)",
      subtitle = "Nét đứt là đường Xu Hướng",
      x = NULL, y = "Tỷ lệ", caption = cap_default
    ) +
    theme_pro() +
    theme(
      panel.grid.major.x = element_blank(),
      axis.text.x = element_text(angle = 45, hjust = 1),
      plot.margin = margin(10, 28, 10, 10)
    )

  if (requireNamespace("ggrepel", quietly = TRUE)) {
    p27 <- base +
      ggrepel::geom_label_repel(
        data = last_pts,
        aes(x = x_lbl, y = Value, label = lbl, color = Metric),
        inherit.aes = FALSE,
        size = 3.1, label.size = 0, fill = "white", fontface = "bold",
        nudge_x = 0, nudge_y = 0,
        min.segment.length = 0, segment.alpha = 0.4,
        direction = "y", box.padding = 0.25, point.padding = 0.3,
        max.overlaps = Inf
      ) +
      coord_cartesian(clip = "off")
  } else {
    message("[INFO] ggrepel chưa cài đặt: dùng geom_label thông thường.")
    p27 <- base +
      geom_label(
        data = last_pts,
        aes(x = x_lbl, y = Value, label = lbl, color = Metric),
        inherit.aes = FALSE, size = 3.1, label.size = 0,
        fill = "white", fontface = "bold"
      ) +
      coord_cartesian(clip = "off")
  }

  print(maybe_plotly(p27))
  maybe_save(p27, "27_margins_loess.png")
}

Phân tích Code:

• Dùng pivot_longer để chuyển dữ liệu sang dạng dài, giúp ggplot có thể tự động vẽ và tô màu ba đường riêng biệt.
• Kết hợp geom_line (dữ liệu gốc) và geom_smooth (xu hướng). Việc dùng đường nét đứt cho xu hướng giúp phân biệt rõ ràng hai loại thông tin.
• Dùng ggrepel để dán nhãn trực tiếp lên cuối mỗi đường. Kỹ thuật này hiệu quả hơn một chú thích riêng biệt vì người xem không cần phải tra cứu.

Kết quả:

• Có một sự phân cấp rõ ràng: Biên gộp > Biên EBIT > Biên ròng. Khoảng cách giữa các đường đại diện cho các lớp chi phí.
• Biên gộp tương đối ổn định. Điều này cho thấy công ty kiểm soát giá vốn tốt.
• Biên EBIT và Biên ròng biến động mạnh hơn, với một cú sụt giảm nghiêm trọng vào cuối năm 2021.

Kết luận: Vì Biên gộp ổn định, sự biến động của các biên lợi nhuận thấp hơn phải đến từ chi phí hoạt động. Các đường xu hướng cho thấy về dài hạn, các biên lợi nhuận tương đối ổn định.

5.5.6 Quỹ đạo Margin và CCC

req <- c("Date","net_margin","ccc")
if (all(req %in% names(df_plot))) {

  # ===== Data & TTM for size =====
  df_b3 <- df_plot |>
    dplyr::select(Date, net_margin, ccc, revenue) |>
    dplyr::arrange(Date) |>
    dplyr::mutate(
      revenue_ttm = if ("revenue" %in% names(df_plot))
        zoo::rollsum(revenue, k = 4, fill = NA, align = "right") else NA_real_,
      Qtr   = zoo::as.yearqtr(Date),
      label_q = format(Qtr, "Q%q %Y")
    )

  # ===== Medians for regimes =====
  med_nm  <- stats::median(df_b3$net_margin, na.rm = TRUE)
  med_ccc <- stats::median(df_b3$ccc,        na.rm = TRUE)

  # ===== Start/End points for labels =====
  start_pt <- df_b3 |>
    dplyr::filter(!is.na(net_margin), !is.na(ccc)) |>
    dplyr::slice_head(n = 1) |>
    dplyr::mutate(lbl = paste0("Bắt đầu\n", label_q))
  end_pt   <- df_b3 |>
    dplyr::filter(!is.na(net_margin), !is.na(ccc)) |>
    dplyr::slice_tail(n = 1) |>
    dplyr::mutate(lbl = paste0("Hiện tại\n", label_q))

  # ===== Spans for smart nudges (x reversed) =====
  rng_x <- range(df_b3$ccc, na.rm = TRUE);  x_span <- diff(rng_x);  if (!is.finite(x_span) || x_span == 0) x_span <- 1
  rng_y <- range(df_b3$net_margin, na.rm = TRUE); y_span <- diff(rng_y); if (!is.finite(y_span) || y_span == 0) y_span <- 0.1
  nudge_right <- -0.10 * x_span   # x reversed => right = negative nudge
  nudge_left  <-  0.10 * x_span

  time_cols <- c("#2563EB", "#8B5CF6", "#F59E0B", "#EF4444")

  pB3 <- ggplot(df_b3, aes(x = ccc, y = net_margin)) +
    # Regime background (4 quadrants)
    annotate("rect", xmin = -Inf, xmax = med_ccc, ymin = med_nm,  ymax = Inf, fill = "#E8F5E9", alpha = .65) +
    annotate("rect", xmin =  med_ccc, xmax =  Inf,  ymin = med_nm,  ymax = Inf, fill = "#FFF8E1", alpha = .65) +
    annotate("rect", xmin = -Inf, xmax = med_ccc, ymin = -Inf,    ymax = med_nm, fill = "#E3F2FD", alpha = .65) +
    annotate("rect", xmin =  med_ccc, xmax =  Inf,  ymin = -Inf,    ymax = med_nm, fill = "#FDE2E2", alpha = .65) +

    geom_vline(xintercept = med_ccc, linetype = "dotted", color = "#94A3B8") +
    geom_hline(yintercept = med_nm,  linetype = "dotted", color = "#94A3B8") +

    # Trajectory with arrow
    geom_path(linewidth = .9, color = "#374151",
              arrow = grid::arrow(length = grid::unit(3, "mm"), type = "closed"), na.rm = TRUE) +

    # Halo + points
    geom_point(color = "white", size = 4.0, alpha = 0.8, na.rm = TRUE) +
    geom_point(aes(color = as.numeric(Date), size = revenue_ttm), alpha = 0.95, na.rm = TRUE) +

    # ===== Non-overlapping labels (ggrepel) =====
    ggrepel::geom_label_repel(
      data = start_pt, aes(label = lbl), seed = 2,
      nudge_x = nudge_left,  nudge_y = -0.06 * y_span,
      force = 2, max.time = 1.5, box.padding = 0.35, point.padding = 0.35,
      min.segment.length = 0, direction = "both",
      segment.color = "#CBD5E1", segment.size = 0.3,
      fill = "white", color = "#111827", size = 3.2, label.size = 0, show.legend = FALSE
    ) +
    ggrepel::geom_label_repel(
      data = end_pt, aes(label = lbl), seed = 3,
      nudge_x = nudge_right, nudge_y =  0.06 * y_span,
      force = 2, max.time = 1.5, box.padding = 0.35, point.padding = 0.35,
      min.segment.length = 0, direction = "both",
      segment.color = "#CBD5E1", segment.size = 0.3,
      fill = "white", color = "#111827", size = 3.2, label.size = 0, show.legend = FALSE
    ) +

    # Scales
    scale_size_continuous(range = c(1.4, 5.5), name = "Doanh thu (TTM)",
                          labels = scales::label_number(big.mark = ".", decimal.mark = ",")) +
    scale_color_gradientn(colours = time_cols, name = "Thời gian",
                          breaks = as.numeric(unique(as.Date(cut(df_b3$Date, "year")))),
                          labels = format(unique(as.Date(cut(df_b3$Date, "year"))), "%Y")) +

    # Extra right padding for labels (x reversed: pad on second mult)
    scale_x_reverse(labels = scales::label_number(accuracy = 1, big.mark = ".", decimal.mark = ","),
                    expand = expansion(mult = c(0.06, 0.32)),
                    name = "CCC (ngày)") +
    scale_y_continuous(labels = pct_fmt, expand = expansion(mult = c(0.06, 0.16)),
                       name = "Net margin") +

    labs(title = "Regime Map: Net margin vs CCC (Quỹ đạo theo thời gian)",
         caption = cap_default) +
    theme_pro() +
    theme(legend.position = "right", plot.title.position = "plot") +
    coord_cartesian(clip = "off")

  print(pB3)
  maybe_save(pB3, "B3_regime_map_margin_ccc_nolabeloverlap.png", w = 9, h = 6)
}

Phân tích Code:

• Dùng giá trị trung vị để chia biểu đồ thành bốn vùng chiến lược, hay còn gọi là các “chế độ” kinh doanh.
• Đảo ngược trục CCC. Việc này đặt vùng lý tưởng (CCC thấp, Net Margin cao) vào góc trên bên phải, giúp Ta dễ đọc biểu đồ.
• Mã hóa bốn chiều dữ liệu vào biểu đồ: Vị trí X là hiệu quả (CCC), vị trí Y là lợi nhuận (Net Margin), màu sắc là thời gian, và kích thước là quy mô doanh thu.

Kết quả:

• Đường quỹ đạo cho thấy hành trình của công ty Ta.
• Biểu đồ xác nhận cuộc khủng hoảng vào cuối năm 2021. Điểm dữ liệu tại thời điểm đó rơi vào vùng tệ nhất (CCC cao, Net Margin âm).
• Sau đó, công ty đã phục hồi và quay trở lại vùng lý tưởng. Các điểm dữ liệu gần đây cho thấy sự cải thiện.
• Kích thước các điểm lớn dần. Điều này cho thấy quy mô doanh thu tăng mà không phải hy sinh hiệu quả hay lợi nhuận.

5.5.7 Phân rã ROE dạng vòng

need <- c("Date","roe","net_margin","asset_turnover","financial_leverage")
if (all(need %in% names(df_plot))) {

  # === 1) Tính đóng góp DuPont (xấp xỉ tuyến tính quanh t-1) ===
  d <- df_plot |>
    dplyr::select(Date, roe, net_margin, asset_turnover, financial_leverage) |>
    dplyr::arrange(Date) |>
    dplyr::mutate(
      nm_lag = dplyr::lag(net_margin),
      at_lag = dplyr::lag(asset_turnover),
      fl_lag = dplyr::lag(financial_leverage),
      roe_lag= dplyr::lag(roe),
      d_nm = net_margin - nm_lag,
      d_at = asset_turnover - at_lag,
      d_fl = financial_leverage - fl_lag,
      contrib_nm = at_lag * fl_lag * d_nm,
      contrib_at = nm_lag * fl_lag * d_at,
      contrib_fl = nm_lag * at_lag * d_fl,
      delta_roe  = roe - roe_lag,
      approx_delta = contrib_nm + contrib_at + contrib_fl,
      resid = delta_roe - approx_delta
    )

  # === 2) Dài + thang điểm phần trăm (điểm %) ===
  d_long <- d |>
    dplyr::select(Date, contrib_nm, contrib_at, contrib_fl) |>
    tidyr::pivot_longer(-Date, names_to = "component", values_to = "value") |>
    dplyr::mutate(
      component = dplyr::recode(component,
        contrib_nm = "Net margin",
        contrib_at = "Asset turnover",
        contrib_fl = "Financial leverage"
      ),
      value_pp = value * 100,
      Date_f   = factor(Date, levels = unique(Date))
    ) |>
    dplyr::filter(!is.na(value_pp))

  # Tổng (≈ ΔROE, bỏ phần dư) để chấm một vòng mảnh phía ngoài
  total_pp <- d_long |>
    dplyr::group_by(Date, Date_f) |>
    dplyr::summarise(total_pp = sum(value_pp, na.rm = TRUE), .groups = "drop")

  # Bảng màu
  pal_bridge <- c(
    "Net margin" = "#0EA5E9",      # sky
    "Asset turnover" = "#F59E0B",  # amber
    "Financial leverage" = "#8B5CF6" # violet
  )

  # === 3) Polar stream (hiếm gặp): geom_col xếp lớp + coord_polar ===
  pB4_radial <- ggplot(d_long, aes(x = Date_f, y = value_pp, fill = component)) +
    # Cột xếp lớp (cả dương lẫn âm) — độ rộng vừa đủ để tạo dòng chảy mượt
    geom_col(width = 0.98, alpha = 0.95, color = NA, position = "stack") +

    # Điểm mảnh biểu thị tổng (≈ ΔROE) mỗi kỳ
    geom_point(data = total_pp, aes(x = Date_f, y = total_pp, color = "Tổng (≈ΔROE)"),
               size = 1.6, inherit.aes = FALSE) +

    scale_fill_manual(values = pal_bridge, name = "Đóng góp ΔROE") +
    scale_color_manual(values = c("Tổng (≈ΔROE)" = "#111827"), name = NULL) +

    # Vòng tròn: theo trục thời gian (theta = x). Bắt đầu ở đỉnh, quay thuận chiều kim đồng hồ.
    coord_polar(theta = "x", start = pi/2, direction = -1, clip = "off") +

    labs(
      title = "Radial ROE Bridge",
      subtitle = "Mỗi nan quạt là một quý",
      x = NULL, y = NULL,
      caption = "Đơn vị: điểm %. ΔROE xấp xỉ tổng đóng góp (bỏ phần dư nhỏ)."
    ) +
    theme_pro() +
    theme(
      legend.position = "top",
      axis.text = element_blank(),
      panel.grid = element_blank(),
      plot.margin = margin(20, 20, 20, 20)
    )

  print(pB4_radial)
  maybe_save(pB4_radial, "B4_radial_roe_bridge.png", w = 9, h = 9)
}

Phân tích Code:

• Tính toán mức độ đóng góp của từng thành phần DuPont vào sự thay đổi của ROE theo từng quý.
• Dùng pivot_longer để chuẩn bị dữ liệu cho việc vẽ biểu đồ.
• Tạo một biểu đồ cột xếp chồng tiêu chuẩn. Sau đó, Ta dùng coord_polar để biến đổi biểu đồ này thành một dạng tròn. Trục thời gian trở thành góc, và giá trị đóng góp trở thành bán kính.

Kết quả:

• Mỗi nan quạt là một quý. Thời gian chạy theo chiều kim đồng hồ.
• Nan quạt hướng ra ngoài cho thấy đóng góp dương vào sự thay đổi của ROE. Nan quạt hướng vào trong cho thấy đóng góp âm.
• Màu cam (Vòng quay tài sản) và màu xanh (Biên lợi nhuận ròng) là các nan quạt lớn nhất.
• Điều này có nghĩa là sự thay đổi trong ROE chủ yếu đến từ sự thay đổi trong hiệu quả sử dụng tài sản và khả năng sinh lời.
• Màu tím (Đòn bẩy tài chính) có đóng góp không đáng kể vào sự thay đổi này.