BÀI TẬP VỀ NHÀ

library(tidyverse)
library(DT)
library(Ecdat)
library(ggplot2)
library(scales)
library(utf8)
library(moments)
library(stats)

1 Tuần 7

library(WDI)
library(rvest)
library(stringr)

1.1 Scrape dữ liệu

1.1.1 Tiki.vn

Laptop

• Trong phần này em thực hiện cào dữ liệu trên web tiki.vn về mặc hàng laptop, đầu tiên em thực hiện lấy trên một trang đầu của web trước.

url <- "https://tiki.vn/laptop/c8095"
page <- read_html(url)
product_names <- page %>% html_nodes(".product-item .name") %>% html_text()
product_prices <- page %>% html_nodes(".product-item .price-discount__price") %>% html_text()
product_p <- page %>% html_nodes(".product-item .badge-under-price") %>% html_text()
product_d <- page %>% html_nodes(".product-item .badge-delivery") %>% html_text()
product_dis <- page %>% html_nodes(".product-item .price-discount") %>% html_text()
data <- data.frame(Product_Name = product_names, Price = product_prices,discount= product_dis,hoantien=product_p,day=product_d)
datatable(data,options = list(scrollX = TRUE))

url <- “https://tiki.vn/laptop/c8095”: Ở dòng này, gán URL của trang web lấy dữ liệu vào biến url.

page <- read_html(url): sử dụng hàm read_html() để đọc nội dung của trang web từ URL đã cho. Kết quả được lưu vào biến page.

product_names <- page %>% html_nodes(“.product-item .name”) %>% html_text(): để lấy tên sản phẩm. Sau đó, html_text() được sử dụng để lấy văn bản từ những nút này

Tương tự, để lấy giá sản phẩm, thông tin giảm giá, hoàn tiền và ngày giao hàng.

Cuối cùng, em tạo một dataframe bằng cách sử dụng các vector dữ liệu đã thu thập. Mỗi vector trở thành một cột trong dataframe.

• Product_Name: tên sản phẩm, thông tin

• Price: giá

• discount: giá và giảm giá

• hoantien: số hoàn tiền ASIA

• day: ngày giao hàng.

Tiếp theo, mở rộng hơn em lấy dữ liệu trong 7 trang về mặc hàng laptop. Bao gồm các thông tin về tên sản phẩm, giá sản phẩm bán ra, giá giảm, chính sách hoàn tiền.

base_url <- "https://tiki.vn/laptop/c8095?src=c.8095.hamburger_menu_fly_out_banner"
pages <- 7
product_names <- c()
product_prices <- c()
product_p <- c()
product_d <- c()
product_dis <- c()

for (page_num in 1:pages) {
  url <- paste0(base_url, "&page=", page_num) 
  page <- read_html(url)
  names <- page %>% html_nodes(".product-item .name") %>% html_text()
  prices <- page %>% html_nodes(".product-item .price-discount__price") %>% html_text()
  p <- page %>% html_nodes(".product-item .badge-under-price") %>% html_text()
  d <- page %>% html_nodes(".product-item .badge-delivery") %>% html_text()
  product_dis <- page %>% html_nodes(".product-item .price-discount") %>% html_text()
  product_names <- c(product_names, names)
  product_prices <- c(product_prices, prices)
  product_p <- c(product_p,p)
  product_d <- c(product_d,d)
}

data <- data.frame(Product_Name = product_names, Price = product_prices,giamgia=product_dis, Day=product_d,hoantien=product_p)

• Sau đó em thực hiện các thao tác là phân ra từng sản phẩm thuộc brands nào dựa trên tên sản phẩm. Ví dụ trong tên sản phẩm có “MSI” thì em sẽ trả kết quả về của brands “MSI”, tương tự cho các sản phầm còn lại thì em được cột biến mới trong data mà em cào về được.

data <- data %>% mutate(brands = ifelse(str_detect(Product_Name, "MSI"), "MSI", ""))
data <- data %>%
    mutate(brands = case_when(
        grepl("MSI", Product_Name) ~ "MSI",
        grepl("Asus", Product_Name) ~ "Asus",
        grepl("Dell", Product_Name) ~ "Dell",
        grepl("Macbook", Product_Name) ~ "Apple",
        grepl("Acer", Product_Name) ~ "Acer",
        grepl("Lenovo", Product_Name) ~ "Lenovo",
        TRUE ~ "Other"))
datatable(data,options = list(scrollX = TRUE))

1.2 Function

Ở phần này, em thực hiện thao tác trên bộ data mà em thực hiện từ tuần 1-5, bộ data BudgetUK. Bao gồm 10 biến và 1519 quan sát mà em đã giới thiệu trong các tuần trước. Và em sẽ tạo thêm các cột biến như là chi tiêu bằng tiền cho thực phẩm, nhiên liệu, quần áo,…và một cột biến nhóm tuổi chủ hộ gia đình.

BUK <- BudgetUK
names(BUK) <- c("TP","NL","QA","R","PT","K","TC","TT","T","TE")
BUK$Tcoded <- cut(BUK$T, breaks=c(18.95,30,50,60), labels=c("trẻ tuổi","trung niên","cao tuổi"))
BUK <- BUK %>% mutate(across(c(TP, NL, QA, R, PT, K),~ . * TC,.names = "{.col}1"))
datatable(BUK,options = list(scrollX = TRUE))

1.2.1 Tạo function tính toán cho 1 biến

Các giá trị thống kê cơ bản mà em muốn tính toán cho 1 biến bao gồm:

• mean: giá trị trung bình của biến, loại bỏ các giá trị NA (không có giá trị).

• median: giá trị trung vị của biến, loại bỏ các giá trị NA.

• mode của biến.

• sd: độ lệch chuẩn của biến, loại bỏ các giá trị NA.

• min: giá trị nhỏ nhất của biến, loại bỏ các giá trị NA.

• max: giá trị lớn nhất của biến, loại bỏ các giá trị NA.

• n: số lượng các giá trị trong biến.

• var: phương sai của biến.

• skewness: độ nghiêng của phân phối biến.

• kurtosis: độ nhọn của phân phối biến.

• unique_values: số lượng giá trị duy nhất trong biến.

• unique_values_pct: phần trăm giá trị duy nhất trong số tổng số giá trị của biến.

• quantiles: các giá trị phân vị của biến tại các mức 25%, 50%, và 75%, loại bỏ các giá trị NA.

mode <- function(x) {
  unique_x <- unique(x)
  unique_x[which.max(tabulate(match(x, unique_x)))]
}
analyze_variable <- function(data, var, ref_value = 0) {
    # Kiểm tra xem đầu vào có phải là dataframe không
    if (is.data.frame(data) == FALSE) {
        stop("Input must be a data frame.")
    }
    # Chọn biến và thực hiện phân tích
    variable <- data[[var]]
    
    # Tính toán các giá trị mô tả cơ bản
    descriptives <- list(
        mean = mean(variable, na.rm = TRUE),
        median = median(variable, na.rm = TRUE),
        mode=  mode(variable),
        sd = sd(variable, na.rm = TRUE),
        min = min(variable, na.rm = TRUE),
        max = max(variable, na.rm = TRUE),
        n = length(variable),
        var= var(variable),
        skewness = skewness(variable, na.rm = TRUE),
        kurtosis = kurtosis(variable, na.rm = TRUE),
        unique_values = length(unique(variable)),
        unique_values_pct = length(unique(variable)) / length(variable),
        quantiles = quantile(variable, probs = c(0.25, 0.5, 0.75), na.rm = TRUE)
    )
    
    # Thực hiện kiểm định Shapiro-Wilk
    shapiro_test <- shapiro.test(variable)
    
    # Thực hiện kiểm định t-test một mẫu
    t_test <- t.test(variable, mu = ref_value)
    
    # Tạo histogram
    hist_plot <- ggplot(data, aes_string(var)) +
        geom_histogram(binwidth = 30, fill = 'blue', color = 'black') +
        xlab(var) +
        ggtitle(paste("Histogram of", var))
    
    # Tạo boxplot
    box_plot <- ggplot(data, aes_string(x = var)) +
        geom_boxplot(fill = 'blue', color = 'black') +
        ggtitle(paste("Boxplot of", var))
    
    # Tạo density plot
    density_plot <- ggplot(data, aes_string(x = var)) +
        geom_density(fill = 'blue') +
        ggtitle(paste("Density plot of", var))
    
    list(descriptives = descriptives, shapiro_test = shapiro_test, t_test = t_test, hist_plot = hist_plot, box_plot = box_plot, density_plot = density_plot)
}

Em sẽ dùng function trên để tính toán cho các cột biến có trong bộ dữ liệu BudgetUK.

• Tính toán chi tiêu thực phẩm.

analyze_variable(BUK,"TP1", ref_value = 100)

## Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
## ℹ Please use tidy evaluation idioms with `aes()`.
## ℹ See also `vignette("ggplot2-in-packages")` for more information.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

## $descriptives
## $descriptives$mean
## [1] 33.00888
## 
## $descriptives$median
## [1] 30.906
## 
## $descriptives$mode
## [1] 36.564
## 
## $descriptives$sd
## [1] 12.30305
## 
## $descriptives$min
## [1] 5.095
## 
## $descriptives$max
## [1] 146.487
## 
## $descriptives$n
## [1] 1519
## 
## $descriptives$var
## [1] 151.365
## 
## $descriptives$skewness
## [1] 1.502399
## 
## $descriptives$kurtosis
## [1] 9.1929
## 
## $descriptives$unique_values
## [1] 1452
## 
## $descriptives$unique_values_pct
## [1] 0.955892
## 
## $descriptives$quantiles
##    25%    50%    75% 
## 24.834 30.906 38.720 
## 
## 
## $shapiro_test
## 
##  Shapiro-Wilk normality test
## 
## data:  variable
## W = 0.91987, p-value < 2.2e-16
## 
## 
## $t_test
## 
##  One Sample t-test
## 
## data:  variable
## t = -212.22, df = 1518, p-value < 2.2e-16
## alternative hypothesis: true mean is not equal to 100
## 95 percent confidence interval:
##  32.38969 33.62808
## sample estimates:
## mean of x 
##  33.00888 
## 
## 
## $hist_plot

## 
## $box_plot

## 
## $density_plot

• Tính toán chi tiêu nhiên liệu.

analyze_variable(BUK,"NL1", ref_value = 100)

## $descriptives
## $descriptives$mean
## [1] 8.267099
## 
## $descriptives$median
## [1] 7.217
## 
## $descriptives$mode
## [1] 7.248
## 
## $descriptives$sd
## [1] 5.500687
## 
## $descriptives$min
## [1] 0
## 
## $descriptives$max
## [1] 74.412
## 
## $descriptives$n
## [1] 1519
## 
## $descriptives$var
## [1] 30.25756
## 
## $descriptives$skewness
## [1] 4.998311
## 
## $descriptives$kurtosis
## [1] 48.11928
## 
## $descriptives$unique_values
## [1] 1327
## 
## $descriptives$unique_values_pct
## [1] 0.8736011
## 
## $descriptives$quantiles
##    25%    50%    75% 
## 5.2115 7.2170 9.8495 
## 
## 
## $shapiro_test
## 
##  Shapiro-Wilk normality test
## 
## data:  variable
## W = 0.67067, p-value < 2.2e-16
## 
## 
## $t_test
## 
##  One Sample t-test
## 
## data:  variable
## t = -649.96, df = 1518, p-value < 2.2e-16
## alternative hypothesis: true mean is not equal to 100
## 95 percent confidence interval:
##  7.990257 8.543942
## sample estimates:
## mean of x 
##  8.267099 
## 
## 
## $hist_plot

## 
## $box_plot

## 
## $density_plot

• Tính toán tổng chi tiêu các hộ gia đình.

analyze_variable(BUK,"TC", ref_value = 100)

## $descriptives
## $descriptives$mean
## [1] 98.69651
## 
## $descriptives$median
## [1] 90
## 
## $descriptives$mode
## [1] 70
## 
## $descriptives$sd
## [1] 43.19288
## 
## $descriptives$min
## [1] 30
## 
## $descriptives$max
## [1] 390
## 
## $descriptives$n
## [1] 1519
## 
## $descriptives$var
## [1] 1865.625
## 
## $descriptives$skewness
## [1] 1.867392
## 
## $descriptives$kurtosis
## [1] 8.695856
## 
## $descriptives$unique_values
## [1] 33
## 
## $descriptives$unique_values_pct
## [1] 0.02172482
## 
## $descriptives$quantiles
## 25% 50% 75% 
##  70  90 120 
## 
## 
## $shapiro_test
## 
##  Shapiro-Wilk normality test
## 
## data:  variable
## W = 0.85753, p-value < 2.2e-16
## 
## 
## $t_test
## 
##  One Sample t-test
## 
## data:  variable
## t = -1.1762, df = 1518, p-value = 0.2397
## alternative hypothesis: true mean is not equal to 100
## 95 percent confidence interval:
##   96.52267 100.87035
## sample estimates:
## mean of x 
##  98.69651 
## 
## 
## $hist_plot

## 
## $box_plot

## 
## $density_plot

1.2.2 Tạo function cho 2 biến

Function bên dưới tạo thống kê giữa hai biến bao gồm tính trung bình, độ lệch chuẩn từng biến, ngoài ra ta có thể thêm tính toán phương sai, trung vị,…Tiếp theo là em thực hiện tính hệ số tương quan, tính hiệp phương sai, tính kiểm định t-test giữa hai biến.

analyze_two_variables <- function(data, var1, var2) {
  # Kiểm tra xem đầu vào có phải là dataframe không
  if (!is.data.frame(data)) {
    stop("Input must be a data frame.")
  }
  
  # Chọn biến và thực hiện phân tích
  variable1 <- data[[var1]]
  variable2 <- data[[var2]]
  
  # Tính toán các giá trị mô tả cơ bản
  descriptives <- list(
    mean_var1 = mean(variable1, na.rm = TRUE),
    mean_var2 = mean(variable2, na.rm = TRUE),
    sd_var1 = sd(variable1, na.rm = TRUE),
    sd_var2 = sd(variable2, na.rm = TRUE),
    correlation = cor(variable1, variable2, use = "complete.obs"),
    covariance = cov(variable1, variable2, use = "complete.obs"),
    t_test = t.test(variable1, variable2)
  )
  
  # Tạo scatter plot
  scatter_plot <- ggplot(data, aes_string(x = var1, y = var2)) +
    geom_point(color="skyblue") +
    geom_smooth(method = "lm", col = "red")+
    ggtitle(paste("Scatter plot of", var1, "and", var2))
  
  # Thực hiện hồi quy tuyến tính
  linear_regression <- lm(formula = paste(var2, "~", var1), data = data)
  
  # Summary of linear regression
  regression_summary <- summary(linear_regression)
  
  list(
    descriptives = descriptives,
    scatter_plot = scatter_plot,
    linear_regression = linear_regression,
    regression_summary = regression_summary
  )
}

• Tính toán mối quan hệ tổng chi tiêu và tổng thu nhập

analyze_two_variables(BUK, "TT", "TC")

## $descriptives
## $descriptives$mean_var1
## [1] 136.2475
## 
## $descriptives$mean_var2
## [1] 98.69651
## 
## $descriptives$sd_var1
## [1] 61.06116
## 
## $descriptives$sd_var2
## [1] 43.19288
## 
## $descriptives$correlation
## [1] 0.4487403
## 
## $descriptives$covariance
## [1] 1183.511
## 
## $descriptives$t_test
## 
##  Welch Two Sample t-test
## 
## data:  variable1 and variable2
## t = 19.568, df = 2732.9, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  33.78809 41.31395
## sample estimates:
## mean of x mean of y 
## 136.24753  98.69651 
## 
## 
## 
## $scatter_plot

## `geom_smooth()` using formula = 'y ~ x'

## 
## $linear_regression
## 
## Call:
## lm(formula = paste(var2, "~", var1), data = data)
## 
## Coefficients:
## (Intercept)           TT  
##     55.4480       0.3174  
## 
## 
## $regression_summary
## 
## Call:
## lm(formula = paste(var2, "~", var1), data = data)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -277.791  -23.539   -6.713   13.287  234.718 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 55.44803    2.42313   22.88   <2e-16 ***
## TT           0.31743    0.01623   19.56   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 38.61 on 1517 degrees of freedom
## Multiple R-squared:  0.2014, Adjusted R-squared:  0.2008 
## F-statistic: 382.5 on 1 and 1517 DF,  p-value: < 2.2e-16

• Tính toán mối quan hệ tổng chi tiêu và chi tiêu cho thực phẩm

analyze_two_variables(BUK, "TP1", "TC")

## $descriptives
## $descriptives$mean_var1
## [1] 33.00888
## 
## $descriptives$mean_var2
## [1] 98.69651
## 
## $descriptives$sd_var1
## [1] 12.30305
## 
## $descriptives$sd_var2
## [1] 43.19288
## 
## $descriptives$correlation
## [1] 0.6059238
## 
## $descriptives$covariance
## [1] 321.9904
## 
## $descriptives$t_test
## 
##  Welch Two Sample t-test
## 
## data:  variable1 and variable2
## t = -57.005, df = 1762.7, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -67.94769 -63.42757
## sample estimates:
## mean of x mean of y 
##  33.00888  98.69651 
## 
## 
## 
## $scatter_plot

## `geom_smooth()` using formula = 'y ~ x'

## 
## $linear_regression
## 
## Call:
## lm(formula = paste(var2, "~", var1), data = data)
## 
## Coefficients:
## (Intercept)          TP1  
##      28.479        2.127  
## 
## 
## $regression_summary
## 
## Call:
## lm(formula = paste(var2, "~", var1), data = data)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -66.091 -21.455  -7.565  12.286 254.583 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 28.47853    2.52592   11.28   <2e-16 ***
## TP1          2.12724    0.07171   29.67   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 34.37 on 1517 degrees of freedom
## Multiple R-squared:  0.3671, Adjusted R-squared:  0.3667 
## F-statistic: 880.1 on 1 and 1517 DF,  p-value: < 2.2e-16

1.3 Indicators của World bank

se <- WDIsearch()
head(se)

##               indicator                                                 name
## 712      5.51.01.10.gdp                                Per capita GDP growth
## 714     6.0.GDP_current                                      GDP (current $)
## 715      6.0.GDP_growth                                GDP growth (annual %)
## 716         6.0.GDP_usd                                GDP (constant 2005 $)
## 717  6.0.GDPpc_constant GDP per capita, PPP (constant 2011 international $) 
## 1557  BG.GSR.NFSV.GD.ZS                         Trade in services (% of GDP)

“se <- WDIsearch()” là tạo ra một tệp dữ liệu có tên “se” chứa kết quả tìm kiếm của tất cả các chỉ số có sẵn trong cơ sở dữ liệu World Development Indicators (WDI).

1.3.1 Hai Indicators về giáo dục (Education)

• indicator= “SL.TLF.ADVN.ZS”: là chỉ số nói về phần trăm của lực lượng lao động có trình độ học vấn cao. Chỉ số này là một phần quan trọng của việc nắm bắt sự phân bố của trình độ học vấn trong lực lượng lao động của một quốc gia, và nó cũng giúp đánh giá năng lực cạnh tranh về mặt kinh tế cũng như tiềm năng cho sự phát triển của một quốc gia trong tương lai

Đầu tiên em dùng WDIsearch để tìm các indicator trong lĩnh vực giáo dục. Sau đó dùng lệnh WDI để lấy dữ liệu của indicator về phân tích. Lệnh na.omit để loại bỏ các giá trị NA. Sau đó em dùng lệnh filter để lọc ra quốc gia Việt Nam.

tmp <- WDIsearch("education")
ed <- WDI(indicator = "SL.TLF.ADVN.ZS")
ed <- na.omit(ed)
datatable(ed,options = list(scrollX = TRUE))

edvn <- ed %>% filter(country=="Vietnam") 

Ngoài sử dụng lệnh filter thì em có thể lọc ra trực tiếp được quốc gia qua câu lệnh WDI bằng các bổ sung thêm tham số country vào câu lệnh.

edvn <- WDI(indicator = "SL.TLF.ADVN.ZS",country="VN")
edvn <- na.omit(edvn)
str(edvn)

## 'data.frame':    13 obs. of  5 variables:
##  $ country       : chr  "Vietnam" "Vietnam" "Vietnam" "Vietnam" ...
##  $ iso2c         : chr  "VN" "VN" "VN" "VN" ...
##  $ iso3c         : chr  "VNM" "VNM" "VNM" "VNM" ...
##  $ year          : int  2022 2021 2020 2019 2018 2017 2016 2015 2014 2013 ...
##  $ SL.TLF.ADVN.ZS: num  86.6 85.3 88.1 87.7 87.7 ...
##  - attr(*, "lastupdated")= chr "2023-06-29"
##  - attr(*, "label")= chr [1:63] "Labor force with advanced education (% of total working-age population with advanced education)" "Labor force with advanced education (% of total working-age population with advanced education)" "Labor force with advanced education (% of total working-age population with advanced education)" "Labor force with advanced education (% of total working-age population with advanced education)" ...
##  - attr(*, "na.action")= 'omit' Named int [1:50] 14 15 16 17 18 19 20 21 22 23 ...
##   ..- attr(*, "names")= chr [1:50] "14" "15" "16" "17" ...

head(edvn,13)

##    country iso2c iso3c year SL.TLF.ADVN.ZS
## 1  Vietnam    VN   VNM 2022          86.59
## 2  Vietnam    VN   VNM 2021          85.28
## 3  Vietnam    VN   VNM 2020          88.12
## 4  Vietnam    VN   VNM 2019          87.72
## 5  Vietnam    VN   VNM 2018          87.65
## 6  Vietnam    VN   VNM 2017          87.64
## 7  Vietnam    VN   VNM 2016          87.53
## 8  Vietnam    VN   VNM 2015          87.74
## 9  Vietnam    VN   VNM 2014          87.78
## 10 Vietnam    VN   VNM 2013          87.27
## 11 Vietnam    VN   VNM 2012          87.12
## 12 Vietnam    VN   VNM 2011          86.75
## 13 Vietnam    VN   VNM 2010          86.67

Nhìn chung, ở Việt Nam % lực lượng lao động có trình độ học vấn cao được duy trì mức ổn định và khá cao, bằng chứng cho thấy rằng từ năm 2013 đến năm 2020 thì có sự tăng từ 87.27%-88.12% và giảm nhẹ ở năm 2021 (85.28%) sau đó lại tiếp tục tăng lên ở năm 2022 lên (86.59%). Điều này cho thấy mức độ giáo dục của lực lượng lao động ở Việt Nam được cải thiện đáng kể, và có thể cung cấp một nền tảng vững chắc cho sự phát triển kinh tế trong tương lai.

edhk <- WDI(indicator = "SL.TLF.ADVN.ZS",country="HK")
edhk <- na.omit(edhk)
head(edhk,13)

##                 country iso2c iso3c year SL.TLF.ADVN.ZS
## 2  Hong Kong SAR, China    HK   HKG 2021          77.08
## 3  Hong Kong SAR, China    HK   HKG 2020          76.98
## 4  Hong Kong SAR, China    HK   HKG 2019          76.49
## 5  Hong Kong SAR, China    HK   HKG 2018          76.66
## 6  Hong Kong SAR, China    HK   HKG 2017          76.79
## 7  Hong Kong SAR, China    HK   HKG 2016          76.18
## 8  Hong Kong SAR, China    HK   HKG 2015          76.55
## 9  Hong Kong SAR, China    HK   HKG 2014          76.01
## 10 Hong Kong SAR, China    HK   HKG 2013          76.61
## 11 Hong Kong SAR, China    HK   HKG 2012          77.27
## 12 Hong Kong SAR, China    HK   HKG 2011          77.63
## 13 Hong Kong SAR, China    HK   HKG 2010          76.13
## 14 Hong Kong SAR, China    HK   HKG 2009          75.86

Hoặc ta có thể so sánh tỉ lệ lực lượng lao động ở Việt Nam và ở Hồng Kông, Trung Quốc thì rõ ràng ta có thể nhận thấy tỉ lệ lực lượng lao động có trình độ học vấn cao ở Việt Nam là cao hơn ở các năm.

Trực quan hóa Việt Nam qua các năm:

edvn <- ed %>% filter(country=="Vietnam")
ggplot(data = edvn, aes(x = year, y = SL.TLF.ADVN.ZS)) +
  geom_line(color = "steelblue") +
  geom_point(color = "steelblue") +
  xlab("Year") +
  ylab("Percentage of Highly Educated Labor Force") +
  ggtitle("Percentage of Highly Educated Labor Force in Vietnam") +
  theme_minimal()

Trực quan hóa các quốc gia qua các năm.

edco <- ed %>% filter(country %in% c("Hong Kong SAR, China","Indonesia","Vietnam","United States","United Kingdom"))
ggplot(data = edco, aes(x = year, y = SL.TLF.ADVN.ZS,color = country, group = country)) +
  geom_line() +
  geom_point() +
  xlab("Year") +
  ylab("%") +
  ggtitle("Percentage of Highly Educated Labor Force in country") +
  theme_minimal()

• indicator= “JI.UEM.NEET.HE.ZS”: là chỉ số dùng để đo lường tỷ lệ của thanh niên (từ 15-24 tuổi) đã hoàn thành học vấn trên trình độ tiểu học nhưng không có việc làm hoặc không đang theo học (% của dân số thanh niên có trình độ học vấn cao).

Chỉ số này giúp đánh giá tình hình thất nghiệp và không theo học trong nhóm dân số có trình độ học vấn cao. Nếu tỷ lệ này cao, nó có thể là dấu hiệu của vấn đề trong việc tạo ra cơ hội việc làm cho những người trẻ tuổi có trình độ học vấn cao hoặc khả năng chưa đủ để thu hút họ vào hệ thống giáo dục tiếp theo. Chỉ số này cũng là một cảnh báo về nguy cơ lãng phí nguồn lực nhân lực có giá trị, bởi vì những người trẻ tuổi có học vấn cao thường mang lại nhiều giá trị cho nền kinh tế và xã hội.

ed1 <- WDI(indicator = "JI.UEM.NEET.HE.ZS")
datatable(ed1,options = list(scrollX = TRUE))

ed1 <- WDI(indicator = "JI.UEM.NEET.HE.ZS",country="THA")
ed1 <- na.omit(ed1)
head(ed1)

##    country iso2c iso3c year JI.UEM.NEET.HE.ZS
## 1 Thailand   THA       2021         0.1343026
## 2 Thailand   THA       2020         0.1371237
## 3 Thailand   THA       2019         0.1320311
## 4 Thailand   THA       2018         0.1354757
## 5 Thailand   THA       2017         0.1336773
## 6 Thailand   THA       2016         0.1320342

Tỷ lệ thanh niên từ 15-24 tuổi đã hoàn thành học vấn trên trình độ tiểu học nhưng không có việc làm hoặc không theo học của Thái Lan từ năm 2016 đến năm 2021.

Dựa trên dữ liệu, chúng ta có thể nhận thấy:

Năm 2016: Tỷ lệ này ở mức 0.1320342 (tương đương 13.20342%).

Năm 2017: Tỷ lệ tăng nhẹ lên 0.1336773 (tương đương 13.36773%).

Năm 2018: Tỷ lệ tăng lên 0.1354757 (tương đương 13.54757%).

Năm 2019: Có một sự giảm nhẹ xuống 0.1320311 (tương đương 13.20311%).

Năm 2020: Tỷ lệ này tăng lên 0.1371237 (tương đương 13.71237%).

Năm 2021: Tỷ lệ này giảm nhẹ xuống 0.1343026 (tương đương 13.43026%)

Tỷ lệ này biến động không quá lớn trong giai đoạn 2016-2021, chỉ rơi vào khoảng từ 13.2% đến 13.7%

Trực quan hóa dữ liệu này ở thái lan.

ggplot(data = ed1, aes(x = year, y = JI.UEM.NEET.HE.ZS)) +
  geom_line(color = "steelblue") +
  geom_point(color = "steelblue") +
  xlab("Year") +
  theme_minimal()

1.3.2 Hai Indicators về tăng trưởng (Growth)

• indicator= “NY.GDP.MKTP.KD.ZG”: là chỉ số thể hiện tỷ lệ phần trăm tăng trưởng của tổng sản phẩm quốc nội (GDP) từ năm này sang năm kế tiếp.

tmp <- WDIsearch("Growth")
gr <- WDI(indicator = "NY.GDP.MKTP.KD.ZG")
gr <- na.omit(gr)
grvn <- WDI(indicator = "NY.GDP.MKTP.KD.ZG", country="VN",
            start=2017,end=2022)
grvn <- na.omit(grvn)
head(grvn)

##   country iso2c iso3c year NY.GDP.MKTP.KD.ZG
## 1 Vietnam    VN   VNM 2022          8.019798
## 2 Vietnam    VN   VNM 2021          2.561551
## 3 Vietnam    VN   VNM 2020          2.865412
## 4 Vietnam    VN   VNM 2019          7.359281
## 5 Vietnam    VN   VNM 2018          7.464991
## 6 Vietnam    VN   VNM 2017          6.940188

Tỷ lệ tăng trưởng GDP hàng năm (%) của Việt Nam từ năm 2017 đến năm 2022.

Dựa trên dữ liệu, chúng ta có thể nhận thấy:

Năm 2017: Tăng trưởng GDP là 6.940188%.

Năm 2018: Tăng trưởng GDP tăng lên 7.464991%.

Năm 2019: Tăng trưởng GDP tiếp tục tăng lên 7.359281%.

Năm 2020: Có một sự giảm mạnh xuống 2.865412%, có thể do tác động của đại dịch COVID-19.

Năm 2021: Tăng trưởng GDP hồi phục nhẹ lên 2.561551%.

Năm 2022: Tăng trưởng GDP tăng mạnh trở lại, đạt 8.019798%.

Nhìn chung, dữ liệu cho thấy Việt Nam đã duy trì một mức tăng trưởng GDP ổn định trước khi đại dịch COVID-19 xảy ra. Đại dịch đã gây ra một ảnh hưởng tiêu cực đáng kể đối với tăng trưởng kinh tế của Việt Nam trong năm 2020 và 2021. Tuy nhiên, tăng trưởng GDP đã hồi phục mạnh mẽ trong năm 2022.

ggplot(data = grvn, aes(x = year, y = NY.GDP.MKTP.KD.ZG)) +
  geom_line(color = "steelblue") +
  geom_point(color = "steelblue") +
  xlab("Year") +
  theme_minimal()

• indicator= “NV.AGR.TOTL.KD.ZG”: là chỉ số thể hiện tỷ lệ phần trăm tăng trưởng thực của sản xuất nông nghiệp (%). Chỉ số này được điều chỉnh theo giá trị thực, tức là đã được điều chỉnh để loại bỏ yếu tố tác động của lạm phát. Do đó, chỉ số này cung cấp một đánh giá chính xác hơn về tăng trưởng thực sự trong sản xuất nông nghiệp so với việc sử dụng giá trị không điều chỉnh.

gr1 <- WDI(indicator = "NV.AGR.TOTL.KD.ZG")
gr1 <- na.omit(gr1)
gr1vn <- WDI(indicator = "NV.AGR.TOTL.KD.ZG", country="VN")
gr1vn <- na.omit(gr1vn)
head(gr1vn)

##   country iso2c iso3c year NV.AGR.TOTL.KD.ZG
## 1 Vietnam    VN   VNM 2022          3.357872
## 2 Vietnam    VN   VNM 2021          3.268472
## 3 Vietnam    VN   VNM 2020          3.039419
## 4 Vietnam    VN   VNM 2019          2.667102
## 5 Vietnam    VN   VNM 2018          4.115444
## 6 Vietnam    VN   VNM 2017          3.168387

Chỉ số tăng trưởng thực của sản xuất nông nghiệp (%) của Việt Nam từ năm 2017 đến 2022.

Dựa trên dữ liệu, chúng ta có thể nhận thấy:

Năm 2017: Tăng trưởng sản xuất nông nghiệp là 3.168387%.

Năm 2018: Tăng trưởng sản xuất nông nghiệp tăng lên 4.115444%

Năm 2019: Tăng trưởng sản xuất nông nghiệp giảm xuống 2.667102%.

Năm 2020: Tăng trưởng sản xuất nông nghiệp tăng lên mức 3.039419%.

Năm 2021: Tăng trưởng sản xuất nông nghiệp tăng nhẹ lên 3.268472%.

Năm 2022: Tăng trưởng sản xuất nông nghiệp tiếp tục tăng lên 3.357872%.

Nhìn chung, dữ liệu cho thấy Việt Nam đã duy trì một mức tăng trưởng ổn định trong sản xuất nông nghiệp từ năm 2017 đến 2022.

ggplot(data = gr1vn, aes(x = year, y =NV.AGR.TOTL.KD.ZG)) +
  geom_line(color = "skyblue") +
  geom_point(color = "steelblue") +
  xlab("Year") +
  theme_minimal()

1.3.3 Hai Indicators về môi trường (Environment)

• indicator= “EN.ATM.CO2E.PC”: là chỉ số lượng khí thải CO2 (tấn trên đầu người). Chỉ số này thường được sử dụng để đánh giá mức độ ô nhiễm môi trường do khí CO2 và cũng như mức độ đóng góp của từng người dân trong việc thải ra CO2. Đây là một yếu tố quan trọng khi xem xét tác động của con người lên biến đổi khí hậu.

tmp <- WDIsearch("Environment")
en <- WDI(indicator = "EN.ATM.CO2E.PC")
en <- na.omit(en)
envn <- WDI(indicator = "EN.ATM.CO2E.PC",country="VN")
envn <- na.omit(envn)
head(en,8)

##                        country iso2c iso3c year EN.ATM.CO2E.PC
## 3  Africa Eastern and Southern    ZH   AFE 2020      0.7954199
## 4  Africa Eastern and Southern    ZH   AFE 2019      0.9152940
## 5  Africa Eastern and Southern    ZH   AFE 2018      0.9214534
## 6  Africa Eastern and Southern    ZH   AFE 2017      0.9338739
## 7  Africa Eastern and Southern    ZH   AFE 2016      0.9413373
## 8  Africa Eastern and Southern    ZH   AFE 2015      0.9604298
## 9  Africa Eastern and Southern    ZH   AFE 2014      1.0137580
## 10 Africa Eastern and Southern    ZH   AFE 2013      1.0011540

Nhìn chung, dữ liệu cho thấy rằng lượng CO2 thải ra mỗi người ở Việt Nam đã tăng lên đáng kể trong giai đoạn từ năm 2013 đến 2020. Đây là một dấu hiệu cho thấy nhu cầu sử dụng năng lượng (đặc biệt là năng lượng từ hóa thạch) của Việt Nam tăng lên, có thể do tăng trưởng kinh tế và công nghiệp. Tuy nhiên, việc tăng lượng khí thải CO2 cũng đồng nghĩa với việc tăng gánh nặng lên môi trường và góp phần làm tăng hiệu ứng nhà kính, một nguyên nhân chính của biến đổi khí hậu

ggplot(data = envn, aes(x = year, y =EN.ATM.CO2E.PC)) +
  geom_line(color = "yellow") +
  geom_point(color = "red") +
  xlab("Year") +
  theme_minimal()

• indicator= “EN.ATM.GHGO.KT.CE”: là chỉ số biểu thị lượng khí thải gây hiệu ứng nhà kính khác, bao gồm các chất gây hiệu ứng nhà kính như HFC (Hydrofluorocarbons), PFC (Perfluorocarbons) và SF6 (Sulfur hexafluoride). Đơn vị đo lường của chỉ số này là kiloton tương đương CO2 (kilotons of CO2 equivalent).

Các chất gây hiệu ứng nhà kính này thường được sử dụng trong các ứng dụng công nghiệp và các hệ thống điều hòa không khí, và chúng góp phần đáng kể vào tác động biến đổi khí hậu. Chỉ số này được sử dụng để đo lường lượng khí thải từ các chất gây hiệu ứng nhà kính này và chuyển đổi chúng thành tương đương CO2 để có thể so sánh và đánh giá tác động của chúng đối với biến đổi khí hậu.

en1 <- WDI(indicator = "EN.ATM.GHGO.KT.CE")
en1 <- na.omit(en1)
en1vn <- WDI(indicator = "EN.ATM.GHGO.KT.CE",country="VN")
en1vn <- na.omit(en1vn)
head(en1vn,8)

##    country iso2c iso3c year EN.ATM.GHGO.KT.CE
## 7  Vietnam    VN   VNM 2016         22687.861
## 8  Vietnam    VN   VNM 2015          7232.352
## 9  Vietnam    VN   VNM 2014        -14464.389
## 10 Vietnam    VN   VNM 2013        -15318.379
## 11 Vietnam    VN   VNM 2012        -14643.617
## 12 Vietnam    VN   VNM 2011         -9805.830
## 13 Vietnam    VN   VNM 2010         -2788.928
## 14 Vietnam    VN   VNM 2009         -6974.719

Nhìn chung, dữ liệu cho thấy Việt Nam đã có sự biến động lớn trong lượng khí thải gây hiệu ứng nhà kính khác từ năm 2009 đến 2016. Các giá trị âm đại diện cho việc hấp thụ khí thải gây hiệu ứng nhà kính từ môi trường hoặc các hoạt động giảm thiểu khí thải. Tuy nhiên, các giá trị dương cho thấy Việt Nam đã tăng cường hoạt động sản xuất và sử dụng chất gây hiệu ứng nhà kính trong thời gian gần đây, góp phần vào tăng lượng khí thải

ggplot(data = en1vn, aes(x = year, y = EN.ATM.GHGO.KT.CE)) +
  geom_line(color = "pink") +
  geom_point(color = "red") +
  xlab("Year") +
  theme_minimal()

1.3.4 Hai Indicators về nợ nước ngoài (External Debt)

• indicator= “FI.RES.TOTL.DT.ZS”: Chỉ số “FI.RES.TOTL.DT.ZS” biểu thị tổng dự trữ (% trên tổng nợ nước ngoài). Đây là tỷ lệ phần trăm của tổng dự trữ tiền tệ của một quốc gia so với tổng số nợ nước ngoài của quốc gia đó. Tỷ lệ tổng dự trữ cao hơn cho thấy quốc gia có khả năng thanh toán nợ nước ngoài cao và có một cơ sở tài chính mạnh mẽ để đáp ứng các nhu cầu thanh toán. Tuy nhiên, một tỷ lệ quá cao cũng có thể cho thấy quốc gia có thể đối mặt với rủi ro về liên quan đến biến động giá trị tài sản dự trữ hoặc khó khăn trong việc sử dụng tài chính để hỗ trợ hoạt động kinh tế nội địa.

tmp <- WDIsearch("External Debt")
ex <- WDI(indicator = "FI.RES.TOTL.DT.ZS")
ex <- na.omit(ex)
exvn <- WDI(indicator = "FI.RES.TOTL.DT.ZS", country="VN")
exvn <- na.omit(exvn)
head(exvn)

##   country iso2c iso3c year FI.RES.TOTL.DT.ZS
## 2 Vietnam    VN   VNM 2021          80.29425
## 3 Vietnam    VN   VNM 2020          75.82745
## 4 Vietnam    VN   VNM 2019          66.75995
## 5 Vietnam    VN   VNM 2018          51.89505
## 6 Vietnam    VN   VNM 2017          47.14693
## 7 Vietnam    VN   VNM 2016          42.63945

Nhìn chung, dữ liệu cho thấy Việt Nam đã tăng cường tổng dự trữ tiền tệ của mình so với tổng nợ nước ngoài từ năm 2016 đến 2021. Tỷ lệ này cho thấy sự đa dạng hóa nguồn tài chính và khả năng thanh toán nợ nước ngoài của quốc gia.

ggplot(data = exvn, aes(x = year, y = FI.RES.TOTL.DT.ZS)) +
  geom_line(color = "purple") +
  geom_point(color = "red") +
  xlab("Year") +
  theme_minimal()

• indicator=“DT.DOD.DECT.CD”: là mã chỉ số cho Nợ ngoại công chính (Tổng số) trong đơn vị USD. Đây là chỉ số đo lường tổng số nợ ngoại công chính của một quốc gia, bao gồm cả nợ công nội địa và nợ công ngoại.

Nợ ngoại công chính bao gồm các khoản nợ mà chính phủ một quốc gia đã tạo ra thông qua việc vay mượn từ các nguồn tài chính ngoại vi hoặc nội địa để tài trợ cho các hoạt động công cộng, bao gồm chính sách xã hội, hạ tầng, giáo dục, y tế và quốc phòng.

Chỉ số này thường được sử dụng để đánh giá mức độ phụ thuộc của một quốc gia vào vốn vay ngoại vi và nội địa để tài trợ cho các hoạt động công cộng và để đo lường khả năng thanh toán nợ của một quốc gia.

ex1 <- WDI(indicator = "DT.DOD.DECT.CD")
ex1 <- na.omit(ex1)
ex1vn <- WDI(indicator = "DT.DOD.DECT.CD", country="VN")
ex1vn <- na.omit(ex1vn)
head(ex1vn)

##   country iso2c iso3c year DT.DOD.DECT.CD
## 2 Vietnam    VN   VNM 2021   136213184768
## 3 Vietnam    VN   VNM 2020   125065027874
## 4 Vietnam    VN   VNM 2019   117338074807
## 5 Vietnam    VN   VNM 2018   106855329179
## 6 Vietnam    VN   VNM 2017   104090689657
## 7 Vietnam    VN   VNM 2016    85665477616

Nhìn chung, dữ liệu cho thấy Việt Nam đã có sự tăng trưởng liên tục trong nợ ngoại công chính từ năm 2016 đến 2021. Điều này có thể phản ánh việc chính phủ Việt Nam sử dụng vốn vay ngoại vi và nội địa để tài trợ cho các hoạt động công cộng và đẩy mạnh phát triển kinh tế và xã hội.

ggplot(data = ex1vn, aes(x = year, y = DT.DOD.DECT.CD)) +
  geom_line(color = "green") +
  geom_point(color = "red") +
  xlab("Year") +
  theme_minimal()

1.3.5 Hai Indicators về thương mại (Trade)

• indicator=“CC.ENV.TRAD.IM”: tỷ lệ giá trị nhập khẩu của các hàng hóa thương mại môi trường so với tổng giá trị nhập khẩu.

tmp <- WDIsearch("Trade")
tr <- WDI(indicator = "CC.ENV.TRAD.IM")
tr <- na.omit(tr)
trvn <- WDI(indicator = "CC.ENV.TRAD.IM",country="VN")
trvn <- na.omit(trvn)
head(trvn)

##    country iso2c iso3c year CC.ENV.TRAD.IM
## 10 Vietnam   VNM       2019     0.05833684
## 11 Vietnam   VNM       2018     0.05117884
## 12 Vietnam   VNM       2017     0.05654404
## 13 Vietnam   VNM       2016     0.04686946
## 14 Vietnam   VNM       2015     0.05207258
## 15 Vietnam   VNM       2014     0.04495668

Tăng giá trị của chỉ số thương mại môi trường nhập khẩu có thể chỉ ra rằng Việt Nam đang nhập khẩu nhiều hơn các sản phẩm và dịch vụ môi trường từ các quốc gia khác.

ggplot(data = trvn, aes(x = year, y = CC.ENV.TRAD.IM)) +
  geom_line(color = "skyblue") +
  geom_point(color = "red") +
  xlab("Year") +
  theme_minimal()

• indicator=“NE.RSB.GNFS.ZS”: cán cân thương mại hàng hóa và dịch vụ (% GDP). Đây là một chỉ số đo lường tỷ lệ giữa giá trị xuất khẩu và nhập khẩu hàng hóa và dịch vụ của một quốc gia so với GDP của quốc gia đó.

Khi chỉ số này có giá trị dương, tức là giá trị xuất khẩu hàng hóa và dịch vụ vượt quá giá trị nhập khẩu, thì quốc gia đó có cán cân thương mại dương (thặng dư thương mại). Điều này cho thấy quốc gia đang xuất khẩu nhiều hơn so với nhập khẩu, và có thể có ảnh hưởng tích cực đến tăng trưởng kinh tế và thị trường việc làm trong quốc gia đó.

Tuy nhiên, khi chỉ số này có giá trị âm, tức là giá trị nhập khẩu vượt quá giá trị xuất khẩu, thì quốc gia đó có cán cân thương mại âm (thâm hụt thương mại). Điều này có thể chỉ ra rằng quốc gia đang phụ thuộc nhiều vào hàng hóa và dịch vụ nhập khẩu, và có thể có tác động tiêu cực đến thị trường việc làm và tăng trưởng kinh tế trong quốc gia đó

ed11 <- WDI(indicator = "NE.RSB.GNFS.ZS")
ed11 <- na.omit(ed11)
ed21 <- WDI(indicator = "NE.RSB.GNFS.ZS",country="VN")
ed21 <- na.omit(ed21)
head(ed21)

##   country iso2c iso3c year NE.RSB.GNFS.ZS
## 2 Vietnam    VN   VNM 2021      0.1151201
## 3 Vietnam    VN   VNM 2020      5.5173322
## 4 Vietnam    VN   VNM 2019      5.6109599
## 5 Vietnam    VN   VNM 2018      4.1829754
## 6 Vietnam    VN   VNM 2017      2.5449606
## 7 Vietnam    VN   VNM 2016      2.8050639

ggplot(data = ed21, aes(x = year, y = NE.RSB.GNFS.ZS)) +
  geom_line(color = "skyblue") +
  geom_point(color = "red") +
  xlab("Year") +
  theme_minimal()

2 TUẦN 4+5+6

Package: Ecdat - Datasets: BudgetUK(Budget Shares of British Household

Mô tả dữ liệu

Số quan sát : 1519

Quan sát : Hộ gia đình

Quốc gia : Vương quốc Anh

Dữ liệu có chứa :

1. wfood: tỷ lệ chi tiêu ngân sách dành cho thực phẩm.

2. wfuel: tỷ lệ chi tiêu ngân sách dành cho chi phí nhiên liệu

3. wcloth: tỷ lệ chi tiêu ngân sách dành cho quần áo thời trang

4. walc: tỷ lệ chi ngân sách chi cho rượu

5. wtrans: tỷ lệ chi tiêu ngân sách dành cho chi phí phương tiện, giao thông vận tải

6. wother: tỷ lệ chi tiêu ngân sách cho các yếu tố khác

7. totexp: tổng chi tiêu hộ gia đình (Được làm tròn đến số tiền gần nhất theo đơn vị 10 bảng Anh)

8. income: tổng thu nhập ròng của hộ gia đình (Được làm tròn đến số tiền gần nhất theo đơn vị 10 bảng Anh)

9. age: tuổi của chủ hộ

10. children: số con trong hộ gia đình

Ở tuần này, em sẽ tổng quát lại các thao tác em đã thực hiện trên toàn bộ dữ liệu BudgetUK. Đầu tiên, em sẽ thực hiện gọi các packages cần thiết. Sau đó lấy dữ liệu gốc copy qua dữ liệu mới có tên là BUK.

library(tidyverse)
library(DT)
library(Ecdat)
library(ggplot2)
library(scales)
library(utf8)

BUK <- BudgetUK

Xem cấu trúc dữ liệu

str(BUK)

## 'data.frame':    1519 obs. of  10 variables:
##  $ wfood   : num  0.427 0.374 0.194 0.444 0.333 ...
##  $ wfuel   : num  0.1342 0.1686 0.4056 0.1258 0.0824 ...
##  $ wcloth  : num  0 0.0091 0.0012 0.0539 0.0399 ...
##  $ walc    : num  0.0106 0.0825 0.0513 0.0397 0.1571 ...
##  $ wtrans  : num  0.1458 0.1215 0.2063 0.0652 0.2403 ...
##  $ wother  : num  0.282 0.244 0.141 0.272 0.147 ...
##  $ totexp  : num  50 90 180 80 90 70 140 50 100 90 ...
##  $ income  : num  130 150 230 100 100 70 190 100 260 110 ...
##  $ age     : num  25 39 47 33 31 24 46 25 30 41 ...
##  $ children: num  2 2 2 2 1 1 1 1 1 1 ...

Hiển thị 6 dòng đầu tiên dữ liệu

head(BUK)

##    wfood  wfuel wcloth   walc wtrans wother totexp income age children
## 1 0.4272 0.1342 0.0000 0.0106 0.1458 0.2822     50    130  25        2
## 2 0.3739 0.1686 0.0091 0.0825 0.1215 0.2444     90    150  39        2
## 3 0.1941 0.4056 0.0012 0.0513 0.2063 0.1415    180    230  47        2
## 4 0.4438 0.1258 0.0539 0.0397 0.0652 0.2716     80    100  33        2
## 5 0.3331 0.0824 0.0399 0.1571 0.2403 0.1473     90    100  31        1
## 6 0.3752 0.0481 0.1170 0.0210 0.0955 0.3431     70     70  24        1

Hiển thị 6 dòng cuối dữ liệu

tail(BUK)

##       wfood  wfuel wcloth   walc wtrans wother totexp income age children
## 1514 0.6218 0.1584 0.0000 0.0000 0.0000 0.2197     40     50  47        1
## 1515 0.4106 0.0402 0.0054 0.0700 0.2256 0.2483     90    120  29        2
## 1516 0.2787 0.1066 0.0176 0.0000 0.2196 0.3775     70     90  34        2
## 1517 0.3298 0.0759 0.2566 0.0292 0.1309 0.1777    100    260  38        2
## 1518 0.6061 0.0459 0.0787 0.0679 0.0259 0.1755    130    160  44        2
## 1519 0.1885 0.0328 0.1279 0.2162 0.1575 0.2771    140    140  27        1

Dưới đây là bảng dữ liệu đầy đủ.

datatable(BUK, options = list( scrollX = TRUE))

2.1 Tính toán thống kê

Để thao tác trên các biến, cũng như các tuần trước em thực hiện đổi tên lại mục đích là làm cho các biến gọn gàng và dễ thực hiện hơn: wfood = ‘TP’, wfuel = ‘NL’, wcloth = ‘QA’, walc =‘R’, wtrans = ‘PT’, wother = ‘K’, totexp = ‘TC’, income = ‘TT’, age = ‘T’, children = ‘TE’. Và thêm một cột biến mới vào dữ liệu bằng cách, phân tổ biến tuổi của chủ hộ gia đình 3 tổ (độ tuổi [19-30] gọi là trẻ tuổi, độ tuổi (30-50] gọi là trung niên, độ tuổi (50-60] gọi là cao tuổi).

names(BUK) <- c("TP","NL","QA","R","PT","K","TC","TT","T","TE")
BUK$Tcoded <- cut(BUK$T, breaks=c(18.95,30,50,60), labels=c("trẻ tuổi","trung niên","cao tuổi"))

Ngoài ra, em còn biến đổi thêm các cột mới như là TP1, NL1, QA1, R1, PT1, K1 chính là các mức tiền chi tiêu cho thực phẩm, nhiên liệu, quần áo, rượu, phương tiện và các chi tiêu khác bằng cách lấy tỉ lệ % ban đầu mà bộ data cung cấp nhân cho tổng chi tiêu với hàm mutate()

BUK <- BUK %>% mutate(across(c(TP, NL, QA, R, PT, K),~ . * TC,.names = "{.col}1"))
datatable(BUK,options = list(scrollX = TRUE))

2.1.1 Hàm summary()

• Hàm summary()

Trong phần này đầu tiên, em thực hiện câu lệnh summary() để tóm tắt thống kê. Hoặc để tính thống kê cho nhiều biến em có thực hiện toán tử %>% sau đó sử dụng hàm sapply().

summary(BUK$TC)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    30.0    70.0    90.0    98.7   120.0   390.0

Hộ gia đình có mức chi tiêu thấp nhất trong 1519 quan sát là 30 tính theo bảng Anh. hộ gia đình có mức chi tiêu cao nhất là 390, mức chi tiêu trung bình của hộ gia đình là 98.7, có 25% hộ gia đình chi tiêu ít hơn 70, có 50% hộ gia đình có mức chi tiêu dưới 90, có 75% hộ gia đình có mức chi tiêu dưới 120.

summary(BUK$TT)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    20.0   100.0   120.0   136.2   160.0  1110.0

Hộ gia đình có mức thu nhập cao nhất ở mức 1110, hộ gia đình có mức thu nhập thấp nhất là ở mức 20, mức thu nhập trung bình của hộ gia đình ở Anh là 136.2, có 25% hộ gia đình có thu nhập dưới 100, có 50% hộ gia đình có mức thu nhập dưới 120, có 75% hộ gia đình có thu nhập dưới 160.

summary(BUK$T)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   19.00   30.00   35.00   35.78   40.00   60.00

Độ tuổi chủ hộ gia đình trong quan sát nhỏ nhất là 19, lớn nhất là 60, có 25% số người chủ hộ gia đình nhỏ hơn 30 tuổi có 50% số chủ hộ gia đình nhỏ hơn 35 tuổi, có 75% số người chủ hộ gia đình nhỏ hơn 40 tuổi. Độ tuổi trung bình trong khảo sát là 35.78 xấp xỉ 36 tuổi.

summary(BUK$TP1)
summary(BUK$QA1)
summary(BUK$R1)
summary(BUK$PT1)
summary(BUK$K1)

Các câu lệnh trên sẽ trả về kết quả tóm tắt về mức chi tiêu lớn nhất, nhỏ nhất trung bình, tứ phân vị cho từng mức chi tiêu cho thực phẩm, quần áo, rượu, phương tiện hay các chi tiêu khác. Hoặc cách khác em dùng toán tử %>% và lệnh sapply() để trả về một bảng kết quả của các cột cần tính.

BUK %>% select(c("TC","TT","T","TP1","NL1","QA1","R1","PT1","K1")) %>% 
  sapply(summary,na.rm= TRUE)

##                TC        TT       T       TP1       NL1       QA1        R1
## Min.     30.00000   20.0000 19.0000   5.09500  0.000000   0.00000  0.000000
## 1st Qu.  70.00000  100.0000 30.0000  24.83400  5.211500   2.59500  1.013500
## Median   90.00000  120.0000 35.0000  30.90600  7.217000   7.67800  3.864000
## Mean     98.69651  136.2475 35.7788  33.00888  8.267099  11.83112  6.244063
## 3rd Qu. 120.00000  160.0000 40.0000  38.72000  9.849500  16.25600  8.820500
## Max.    390.00000 1110.0000 60.0000 146.48700 74.412000 240.04500 70.452000
##              PT1        K1
## Min.      0.0000   1.98000
## 1st Qu.   4.8800  14.05350
## Median   10.2900  20.59200
## Mean     13.7366  25.60862
## 3rd Qu.  16.9640  30.49050
## Max.    236.7780 198.15700

2.1.2 Hàm sum(),sapply(), var(), sd(), quantile()

• Hàm sum(), sapply()

Ở hàm sum thì em thực hiện tính tổng chi tiêu, tổng thu nhập của các hộ gia đình trong dữ liệu. Hoặc em tính sum của từng cột biến như là thực phẩm, quần áo,…bằng lệnh sapply, sau đó đưa ra so sánh mức chi tiêu cho yếu tố nào ở tất cả hộ gia đình ở Anh là nhiều nhất.

sum(BUK$TC)

## [1] 149920

sum(BUK$TT)

## [1] 206960

BUK %>% select(c("TC","TT","TP1","NL1","QA1","R1","PT1","K1")) %>% 
  sapply(sum, na.rm = TRUE)

##         TC         TT        TP1        NL1        QA1         R1        PT1 
## 149920.000 206960.000  50140.493  12557.724  17971.472   9484.731  20865.893 
##         K1 
##  38899.496

Từ kết quả trên, ta thấy được rằng tổng chi tiêu của 1519 hộ gia đình ở anh là 149920, tổng chi tiêu cho thực phẩm là cao nhất 50140.493, tổng chi tiêu cho rượu là thấp nhất 9484.731, tổng thu nhập của các hộ gia đình ở Anh là 206960 cao hơn so với mức tổng chi tiêu.

Bên dưới là mức chi tiêu trung bình cho từng cột được trả về kết quả là một bảng để so sánh, ngoài ra thì ta còn dùng lệnh sapply() để tính toán sd(), var(), quantile(),… cho nhiều cột để dễ so sánh đưa ra kết luận hơn thay vì tính từng cột.

BUK %>% select(c("TP1","NL1","QA1","R1","PT1","K1")) %>% 
  sapply(mean,na.rm= TRUE)

##       TP1       NL1       QA1        R1       PT1        K1 
## 33.008883  8.267099 11.831120  6.244063 13.736598 25.608621

• Hàm sd(), var(), quantile()

var(BUK$NL1)

## [1] 30.25756

var(BUK$R1)

## [1] 57.5824

var(BUK$K1)

## [1] 355.7111

30.25756 đại diện cho mức độ phân tán của các giá trị chi tiêu ngân sách cho yếu tố nhiên liệu quanh giá trị trung bình; 57.5824 đại diện cho mức độ phân tán của các giá trị chi tiêu ngân sách cho yếu tố rượu quanh giá trị trung bình, tương tự ta nhận xét được var(BUK$K1).

sd(BUK$K1)

## [1] 18.86031

sd(BUK$TP1)

## [1] 12.30305

sd(BUK$QA1)

## [1] 14.61806

Độ lệch chuẩn đo lường mức độ phân tán của các giá trị của biến trong tập dữ liệu.

quantile(BUK$TP1,0.45)

##    45% 
## 29.941

quantile(BUK$QA1,0.63)

##      63% 
## 11.38434

Có 45% hộ gia đình chi tiêu cho thực phẩm dưới mức 29.941. Có 63% hộ gia đình chi tiêu cho quần áo dưới mức 11.38434. Ngoài ra, còn có thể thực hiện quantile ở dừng mức % mà ta muốn biến cho các yếu tố khác.

2.1.3 Hàm aggregate - Toán tử %>%

aggregate(BUK$TP1,list(BUK$Tcoded),FUN ='mean')

##      Group.1        x
## 1   trẻ tuổi 28.77565
## 2 trung niên 34.33578
## 3   cao tuổi 37.19184

Hàm trên trả cho ta kết quả về mức chi tiêu trung bình dành cho thực phẩm ở các nhóm tuổi, ở nhóm trẻ tuổi thì mức chi tiêu trung bình dành cho thực phẩm là 28.78 tính theo bảng Anh, ở nhóm tung niên thì mức chi tiêu trung bình dành cho thực phẩm là 34.34, ở nhóm cao tuổi thì mức chi tiêu trung bình cho thực phẩm là 37.19 bảng Anh. Qua đó ta có thể nhận xét, ở nhóm cao tuổi thì mức chi tiêu trung bình dành cho thực phẩm ở nhóm cao tuổi là cao nhất và thấp nhất ở nhóm trẻ tuổi.

aggregate(BUK$TP1,list(BUK$Tcoded),FUN ='max')

##      Group.1       x
## 1   trẻ tuổi  85.320
## 2 trung niên  90.540
## 3   cao tuổi 146.487

Ở câu lệnh trên thì sẽ cho ta kết quả về mức chi tiêu cao nhất dành cho thực phẩm (Tính theo bảng Anh) phân theo nhóm tuổi ở nhóm trẻ tuổi thì hộ gia đình có mức chi tiêu cao nhất dành cho thực phẩm là 85.32, ở nhóm trung niên thì hộ gia đình có mức chi tiêu cao nhất dành cho thực phẩm là 90.54, ở nhóm cao tuổi thì hộ gia đình có mức chi tiêu cao nhất dành cho thực phẩm là 146.487.

BUK %>% group_by(Tcoded) %>% summarise_at(c("TP1","QA1","R1"),list(n=mean))

## # A tibble: 3 × 4
##   Tcoded     TP1_n QA1_n  R1_n
##   <fct>      <dbl> <dbl> <dbl>
## 1 trẻ tuổi    28.8  9.80  6.73
## 2 trung niên  34.3 12.5   6.10
## 3 cao tuổi    37.2 12.9   5.58

Ngoài ra, em có dùng toán tử %>% và summarise_at để tính tổng hợp mức chi tiêu trung bình cho từng yếu tố như là thực phẩm, quần áo, hay là rượu hay rất nhiều yếu tố còn lại dữ liệu. giờ em muốn so sánh mức chi tiêu trung bình của ba cái như là thực phẩm, quần áo và rượu thì em nhận thấy mức chi tiêu trung bình cho thực phẩm là cao nhất ở từng nhóm tuổi.

2.2 Lọc dữ liệu

Ở phần này, em sẽ lọc ra các dữ liệu có tên là loc1, loc2, loc3, loc4 lần lượt ứng với các điều kiện sau:

• Lọc ra các hộ có thu nhập lớn hơn chi tiêu

• Lọc ra các hộ gia đình có thu nhập nhỏ hơn chi tiêu và thuộc độ tuổi trung niên.

• Lọc ra các hộ gia đình có thu nhập lớn hơn chi tiêu và có số con trong gia đình là 2

• Lọc ra các hộ gia đình có số con là 2 hoặc thuộc nhóm trẻ tuổi.

loc1 <- BUK %>% filter(TT>TC)
loc2 <- BUK %>% filter(TT<TC & Tcoded=="trung niên")
loc3 <- BUK %>% filter(TT>TC & TE=="2")
loc4 <- BUK %>% filter(TE=="2"|Tcoded=="trẻ tuổi")

dim(loc1)

## [1] 1226   17

dim(loc2)

## [1] 137  17

dim(loc3)

## [1] 736  17

Từ 1519 quan sát khi ta thêm điều kiện thu nhập lớn hơn chi tiêu thì số quan sát còn lại là 1226. Và số hộ gia đình có thu nhập nhỏ hơn chi tiêu và thuộc nhóm tuổi trung niên là 137 hộ, số hộ gia đình có thu nhập lớn hơn chi tiêu và có số con trong gia đình là 2 có 736 hộ. Ngoài ra để xem dữ liệu khi học em có thể thực hiện câu lệnh datatable().

Ngoài ra, còn có các câu lệnh dùng để lọc như %in% hay là !. Ví dụ:

• Lọc ra số hộ gia đình có thu nhập lớn hơn chi tiêu và không phải là trung niên(loc5)

loc5 <- BUK %>% filter(TT >TC & Tcoded != "trung niên")

• lọc ra hộ gia đình là hộ trung niên và trẻ tuổi

loc6 <- BUK %>% filter(Tcoded %in% c("trung niên", "trẻ tuổi"))

2.3 Bảng tần số, bảng tần suất, đồ thị

2.3.1 Bảng tần số cho biến nhóm tuổi chủ hộ gia đình.

• Để quan sát xem có bao nhiêu hộ gia đình thuộc các nhóm tuổi trong dữ liệu và tỉ lệ % thì em lập bảng tần số và tần suất cho biến Tcoded.

table(BUK$Tcoded)

## 
##   trẻ tuổi trung niên   cao tuổi 
##        400       1046         73

prop.table(table(BUK$Tcoded))

## 
##   trẻ tuổi trung niên   cao tuổi 
## 0.26333114 0.68861093 0.04805793

Hoặc có thể dùng count và mutate()

BUK  %>% count(Tcoded) %>% mutate(pc = scales::percent(n/sum(n)))

##       Tcoded    n  pc
## 1   trẻ tuổi  400 26%
## 2 trung niên 1046 69%
## 3   cao tuổi   73  5%

Trong 1519 quan sát, trong đó có 400 hộ gia đình thuộc nhóm trẻ tuổi chiếm xấp xỉ 26,33%; có 1046 hộ gia đình thuộc nhóm tuổi trung niên chiếm 68.86%; còn lại là 73 hộ gia đình có chủ hộ thuộc nhóm cao tuổi chiếm 4.81%.

• Đồ thị cột cho bảng tần số và tần suất

BUK %>% 
  ggplot(aes(Tcoded)) +
  geom_bar(fill = "purple") +
  geom_text(aes(label = scales::percent(after_stat(count / sum(count)), accuracy = .01)), 
            stat = "count", color = "red", vjust = -0.5) +
  theme_classic() +
  labs(x = "Nhóm tuổi", y = "Số hộ gia đình")

• Đồ thị dạng tròn

BUK %>% group_by(Tcoded) %>% summarise(n = n()) %>% mutate(percentage = n/sum(n)) %>% 
ggplot(aes(x = "", y = percentage, fill = Tcoded)) +
  geom_bar(stat = "identity", width = 1) +
  geom_text(aes(label = paste0(round(percentage*100), "%")), position = position_stack(vjust = 0.5))+
  coord_polar("y", start = 0) +
  scale_fill_manual(values = c("skyblue", "purple", "pink"), name = "Nhóm tuổi") +
  labs(title = "BIỂU ĐỒ PHÂN BỐ NHÓM TUỔI") +
  theme_void() +
  theme(legend.position = "bottom")

2.3.2 Bảng tần số cho biến số con trong hộ gia đình

• Để quan sát có bao nhiêu hộ gia đình theo số con trong gia đình và tỉ lệ % thì em lập bảng tần số và bảng tần suất cho biến TE của bộ dữ liệu.

table(BUK$TE)

## 
##   1   2 
## 594 925

prop.table(table(BUK$TE))

## 
##         1         2 
## 0.3910467 0.6089533

BUK  %>% count(TE) %>% mutate(pc = scales::percent(n/sum(n)))

##   TE   n  pc
## 1  1 594 39%
## 2  2 925 61%

Trong 1519 quan sát thì có 594 hộ gia đình có số con là 1 chiếm 39.1% và có 925 hộ gia đình có số con là 2 chiếm 60.9%.

• Đồ thị cột

BUK %>% 
  ggplot(aes(TE)) +
  geom_bar(fill = "purple") +
  geom_text(aes(label = scales::percent(after_stat(count / sum(count)), accuracy = .01)), 
            stat = "count", color = "red", vjust = -0.5) +
  theme_classic() +
  labs(x = "Số con trong hộ gia đình", y = "Số hộ gia đình")

• Biểu đồ tròn

BUK %>% group_by(TE) %>% summarise(n=n()) %>% 
  mutate(pc=n/sum(n)) %>% 
  ggplot(aes(x="",y=pc,fill=factor(TE)))+
  geom_bar(stat = "identity", width = 1) +
  geom_text(aes(label = paste0(round(pc*100), "%")), position = position_stack(vjust = 0.5))+
  coord_polar("y", start = 0) +
  scale_fill_manual(values = c("skyblue", "pink"), name = "Số con") +
  labs(title = "BIỂU ĐỒ PHÂN BỐ SỐ CON TRONG HỘ GIA ĐÌNH") +
  theme_void()

2.3.3 Bảng tần số giữa số con trong gia đình và nhóm tuổi chủ hộ gia đình

• Tiếp theo em kết hợp quan sát hai biến Tcoded và TE

tmp <- table(BUK$Tcoded,BUK$TE)
addmargins(tmp)

##             
##                 1    2  Sum
##   trẻ tuổi    215  185  400
##   trung niên  330  716 1046
##   cao tuổi     49   24   73
##   Sum         594  925 1519

prop.table(tmp)

##             
##                       1          2
##   trẻ tuổi   0.14154049 0.12179065
##   trung niên 0.21724819 0.47136274
##   cao tuổi   0.03225806 0.01579987

Bên dưới là bảng tính % cho từng nhóm tuổi và đếm số lượng theo nhóm tuổi.

BUK %>% group_by(Tcoded) %>% count(TE) %>% mutate(percent = scales::percent(n/sum(n)))

## # A tibble: 6 × 4
## # Groups:   Tcoded [3]
##   Tcoded        TE     n percent
##   <fct>      <dbl> <int> <chr>  
## 1 trẻ tuổi       1   215 53.8%  
## 2 trẻ tuổi       2   185 46.2%  
## 3 trung niên     1   330 32%    
## 4 trung niên     2   716 68%    
## 5 cao tuổi       1    49 67%    
## 6 cao tuổi       2    24 33%

Số quan sát trong bộ dữ liệu trên là 1519 hộ gia đình có 400 hộ gia đình thuộc nhóm trẻ tuổi, 1046 hộ gia đình thuộc nhóm tuổi trung niên và 73 hộ gia đình thuộc nhóm cao tuổi. Trong 400 hộ gia đình trẻ tuổi thì có 215 hộ gia đình có 1 con và có 185 hộ gia đình có 2 con; trong 1046 hộ gia đình trung niên có 330 hộ gia đình có 1 con và có 716 hộ gia đình có 2 con; trong 73 hộ gia đình thuộc nhóm cao tuổi thì có 49 hộ gia đình là có 1 con và có 24 hộ gia đình là có 2 con.

• Đồ thị cột đôi.

BUK %>% count(Tcoded,TE) %>% mutate(pc=prop.table(n)) %>% 
  ggplot(aes(x = Tcoded, y = n, fill = factor(TE))) +
  geom_col(position = "dodge") +
  geom_text(aes(label=percent(pc, accuracy = .01)), position = position_dodge(1), vjust = -.5, size = 3)+
  labs(title = "Biểu đồ cột đôi",
       x = "Nhóm tuổi",
       y = "Số lượng",
       fill = "TE") +
  theme_minimal()

• Đồ thị cột chồng.

BUK %>% count(Tcoded,TE) %>% mutate(pc=prop.table(n)) %>%
  ggplot(aes(x = Tcoded, y = n, fill = factor(TE))) +
  geom_col() +
  geom_text(aes(label = percent(pc, accuracy = .01)), position = position_stack(vjust = 0.5), size = 2) +
  ylab('Số Người') +
  xlab('Số Con')

2.3.4 Bảng tần số cho dữ liệu đã lọc (loc1)

• Ngoài ra, em còn lập bảng tần số để xem trong số hộ gia đình có thu nhập lớn hơn chi tiêu thì em thống kê theo nhóm tuổi và số con trong gia đình.

tmp <- table(loc1$Tcoded,loc1$TE)
addmargins(tmp)

##             
##                 1    2  Sum
##   trẻ tuổi    175  140  315
##   trung niên  279  580  859
##   cao tuổi     36   16   52
##   Sum         490  736 1226

prop.table(tmp)

##             
##                       1          2
##   trẻ tuổi   0.14274062 0.11419250
##   trung niên 0.22756933 0.47308320
##   cao tuổi   0.02936378 0.01305057

Trong 1226 hộ gia đình có thu nhập lớn hơn chi tiêu, thì có 315 hộ gia đình thuộc nhóm trẻ tuổi, 859 hộ gia đình thuộc nhóm trung niên và 52 hộ gia đình thuộc nhóm cao tuổi. Trong 315 hộ gia đình thuộc nhóm trẻ tuổi thì có 175 hộ là có 1 con chiếm 14.27% và có 140 hộ gia đình có 2 con chiếm 11.42%; trong 859 hộ gia đình thuộc nhóm tuổi trung niên, có 279 hộ gia đình có 1 con chiếm 22.76% và có 580 hộ gia đình có 2 con chiếm 47.31%; trong 52 hộ gia đình thuộc nhóm cao tuổi thì có 36 hộ có 1 con chiến 2.94% và có 16 hộ có 2 con chiếm 1.31%.

• Đồ thị cột

loc1 %>% count(Tcoded,TE) %>% mutate(pc=prop.table(n)) %>% 
  ggplot(aes(x = Tcoded, y = n, fill = factor(TE))) +
  geom_col(position = "dodge") +
  geom_text(aes(label=percent(pc, accuracy = .01)), position = position_dodge(1), vjust = -.5, size = 3)+
  labs(x = "Nhóm tuổi",
       y = "Số lượng",
       fill = "TE") +
  theme_minimal()

2.4 Đồ thị scatter plots đa biến, biểu đồ tương quan

2.4.1 Đồ thị scatter plots đa biến

Đoạn mã sau sẽ tạo ra một biểu đồ ma trận tương quan với đồ thị phân tán (scatterplots) trong tam giác trên và đồ thị histogram trên đường chéo chính. Đối số histogram = TRUE đảm bảo rằng đồ thị histogram được bao gồm trong biểu đồ. Đối số pch = 19 thiết lập ký hiệu được sử dụng để vẽ các điểm trong đồ thị phân tán.

library("PerformanceAnalytics")
mydata <- BUK[,c("TP1","NL1","QA1","R1","PT1","K1","TT","TC")]
chart.Correlation(mydata, histogram=TRUE, pch=19)

Các biểu đồ scatterplot ở dưới phần ma trận tương quan biểu diễn quan hệ giữa hai biến. Có thể nhìn vào đây để xem liệu mối quan hệ giữa hai biến có phải là tuyến tính hay không(Nhìn vào ta có thể nhận xét được các cặp biến gần như có mối quan hệ tuyến tính như là TC và TP1; K1 và TP1) ngoài ra đồ thị trên còn cho thấy biểu đồ histogram trên đường chéo chính của ma trận tương quan cho thấy phân phối của mỗi biến đơn lẻ trong tập dữ liệu từ đó đưa ra một vài kết luận về phân phối của các biến. Các con số nằm ở nữa tam giác trên cho thấy mối tương quan giữa hai biến, mức độ tin cậy và mối quan hệ giữa hai biến trong dữ liệu. Ngoài ra, để nhìn rõ hơn về các hệ số tương quan ta có thể vẽ biểu đồ tương quan phía dưới.

2.4.2 Biểu đồ ma trận tương quan

cor_matrix <- cor(BUK[, c("TP1","NL1","QA1","R1","PT1","K1","TC","TT","T","TE")])
cor_data <- as.data.frame(as.table(cor_matrix))
colnames(cor_data) <- c("Var1", "Var2", "Correlation")
ggplot(data = cor_data, aes(x = Var1, y = Var2)) +
  geom_tile(aes(fill = Correlation)) +
  geom_text(aes(label = round(Correlation, 2)), color = "black", size = 3) +
  scale_fill_gradient2(low = "blue", mid = "white", high = "red", midpoint = 0) +
  theme_minimal()

Dựa vào ma trận tương quan của các biến, ta có thể đọc và kết luận được mức độ tương quan mạnh yếu giữa các biến khác nhau: Hệ số ma trận tương quan của biến tổng chi tiêu (TC) và biến thực phẩm (TP1) là 0.61 con số này cho thấy giá trị này là dương và có giá trị tương đối cao, điều này cho thấy rằng mức chi tiêu cho thực phẩm có xu hướng tăng cùng với mức tổng chi tiêu của hộ gia đình. Hệ số ma trận tương quan của biến tổng chi tiêu (TC) và biến mức chi ngân sách cho nhiên liệu(NL1) là 0.3 giá trị này là dương và có giá trị tương đối trung bình, điều này cho thấy rằng mức chi tiêu cho nhiên liệu có xu hướng tăng cùng với mức tổng chi tiêu của hộ gia đình, tuy nhiên mức độ tương quan không mạnH. Tương tự ta có thể đọc được kết quả của từng cặp biến khác để phù hợp kết quả nghiên cứu.

2.5 Phân tích ảnh hưởng của nhóm tuổi chủ hộ gia đình lên thu nhập và chi tiêu

• Lập bảng chi tiêu trung bình và thu nhập trung bình hộ gia đình theo nhóm tuổi

bu <- BUK %>% group_by(Tcoded) %>% summarise(TC_mean=mean(TC),TT_mean=mean(TT))
bu

## # A tibble: 3 × 3
##   Tcoded     TC_mean TT_mean
##   <fct>        <dbl>   <dbl>
## 1 trẻ tuổi      84.6    112.
## 2 trung niên   104.     145.
## 3 cao tuổi     105.     139.

• Lập bảng ANOVA, xem coi độ tuổi chủ hộ gia đình có ảnh hưởng đến mức chi tiêu và thu nhập hay không.

tct <- aov(TC ~ Tcoded, data = BUK)
summary(tct)

##               Df  Sum Sq Mean Sq F value   Pr(>F)    
## Tcoded         2  108099   54050   30.08 1.54e-13 ***
## Residuals   1516 2723920    1797                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

ttt <- aov(TT ~ Tcoded, data = BUK)
summary(ttt)

##               Df  Sum Sq Mean Sq F value Pr(>F)    
## Tcoded         2  310959  155479   44.07 <2e-16 ***
## Residuals   1516 5348852    3528                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Từ đó, ta nhận xét được Pr(>F): giá trị p-value là 1.54e-13 và <2e-16, rất nhỏ hơn mức ý nghĩa thông thường 0.05. Điều này cho thấy có sự khác biệt đáng kể giữa chi tiêu và thu nhập các nhóm tuổi trong biến “Tcoded”. Mức chi tiêu trung bình của các nhóm tuổi có xu hướng tăng dần từ nhóm trẻ tuổi đến nhóm trung niên và nhóm cao tuổi( người trẻ tuổi có chi tiêu trung bình là 84,6 thấp nhất và cao nhất là người cao tuổi 105,3425). Tuy nhiên, mức thu nhập trung bình có sự biến động khác nhau giữa các nhóm tuổi, ngươì có độ tuổi trung niên có trung bình tổng thu nhập cao nhất.

• Đồ thị.

ggplot(bu) +
  geom_col(aes(x = Tcoded, y = TT_mean, fill = "Thu nhập"), position = "dodge") +
  geom_col(aes(x = Tcoded, y = TC_mean, fill = "Chi tiêu"), position = "dodge") +
  labs(x = "Nhóm", y = "Giá trị") +
  ggtitle("Mức chi tiêu và thu nhập trung bình giữa các nhóm tuổi") +
  scale_fill_manual(values = c("Chi tiêu" = "pink", "Thu nhập" = "skyblue")) +
  theme_minimal()

2.6 Phân tích số con trong gia đình ảnh hưởng lên mức chi tiêu và thu nhập hộ gia đình

• Lập ra bảng chi tiêu trung bình theo từng nhóm hộ gia đình.

bu <- BUK %>% group_by(TE) %>% summarise(TC_mean=mean(TC),TT_mean=mean(TT))
bu

## # A tibble: 2 × 3
##      TE TC_mean TT_mean
##   <dbl>   <dbl>   <dbl>
## 1     1    94.8    134.
## 2     2   101.     137.

• Lập bảng ANOVA, xem coi số con trong hộ gia đình có ảnh hưởng đáng kể lên thu nhập và chi tiêu hộ gia đình hay không.

mo <- aov(TC ~ TE, data = BUK)
summary(mo)

##               Df  Sum Sq Mean Sq F value  Pr(>F)   
## TE             1   14444   14444   7.777 0.00536 **
## Residuals   1517 2817575    1857                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

mo1 <- aov(TT ~ TE, data = BUK)
summary(mo1)

##               Df  Sum Sq Mean Sq F value Pr(>F)
## TE             1    3663    3663   0.982  0.322
## Residuals   1517 5656148    3729

Dựa vào kết quả ANOVA ta thấy được giá trị p-value là 0.00536, nhỏ hơn mức ý nghĩa 0.05, cho thấy có sự khác biệt đáng kể về mức chi tiêu của các hộ gia đình có số con khác nhau, hộ gia đình có nhiều con hơn thì mức chi tiêu trung bình cao hơn. Tuy nhiên, Giá trị p-value 0.322 lớn hơn mức ý nghĩa 0.05, cho thấy không có đủ bằng chứng thống kê để kết luận rằng số con trong hộ gia đình có ảnh hưởng đáng kể đến mức thu nhập.

• Đồ thị.

ggplot(bu, aes(x = TE, y = TC_mean)) +
  geom_col(fill="yellow") +
  labs(x = "Nhóm", y = "Mức chi tiêu") +
  ggtitle("Mức chi tiêu trung bình theo số con trong hộ gia đình") +
  theme_minimal()

2.7 Phân tích sự ảnh hưởng hai biến chi tiêu cho thực phẩm và tổng chi tiêu ở các nhóm tuổi

2.7.1 Phân tích chi tiêu cho thực phẩm ảnh hưởng tổng chi tiêu của các hộ gia đình

• Đầu tiên để phân tích sự ảnh hưởng hai biến lên nhau em sẽ đi tính hồi quy hai biến.

hq <- lm(TC~TP1,BUK)
summary(hq)

## 
## Call:
## lm(formula = TC ~ TP1, data = BUK)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -66.091 -21.455  -7.565  12.286 254.583 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 28.47853    2.52592   11.28   <2e-16 ***
## TP1          2.12724    0.07171   29.67   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 34.37 on 1517 degrees of freedom
## Multiple R-squared:  0.3671, Adjusted R-squared:  0.3667 
## F-statistic: 880.1 on 1 and 1517 DF,  p-value: < 2.2e-16

Mô hình hồi quy tuyến tính: TC = 28.47853 + 2.12724 TP1

Hệ số hồi quy cho “TP1” là 2.12724. Điều này nghĩa là, cho mỗi đơn vị tăng của “TP1”, giá trị dự kiến cho “TC” tăng lên 2.12724, giả sử tất cả các biến khác không thay đổi.

p-values cho cả hai hệ số đều nhỏ hơn 0.001, điều này cho thấy rằng cả hai hệ số đều đáng kể về mặt thống kê.

R-squared: R-squared cho mô hình là 0.3671. Điều này có nghĩa là mô hình này giải thích được khoảng 36.71% sự biến động trong biến phụ thuộc “TC”.

F-statistic (Thống kê F): Giá trị thống kê F rất lớn (880.1) và giá trị p-value liên quan đến nó rất nhỏ (< 2.2e-16), cho thấy mô hình hồi quy này đáng kể về mặt thống kê, tức là nó phù hợp với dữ liệu tốt hơn so với mô hình không có bất kỳ biến nào.

Vì vậy, dựa trên kết quả này, chúng ta có thể kết luận rằng biến “TP1” có ảnh hưởng đáng kể đến biến “TC”. Tuy nhiên, mô hình này chỉ giải thích được khoảng 36.71% sự biến động trong “TC”, vì vậy có thể có các biến khác cũng ảnh hưởng đến “TC”.

• Đồ thị phân tán:

BUK %>% ggplot(aes(x=TP1,y=TC))+
  geom_point(color="skyblue")+
  geom_smooth(formula = y~x,method = "lm",color="red")+
  labs(x="Chi tiêu cho thực phẩm",y="Tổng chi tiêu",title="Ảnh hưởng chi tiêu cho thực phẩm lên tổng chi tiêu của hộ gia đình")

• Xem sự ảnh hưởng từng nhóm tuổi chi tiêu cho thực phẩm ảnh hưởng lên tổng chi tiêu hộ gia đình như thế nào.

BUK %>% ggplot(aes(x=TP1,y=TC,color= Tcoded))+
  geom_point()+
  geom_smooth(aes(color=Tcoded), formula = y~x,method = "lm")+
  labs(x="Chi tiêu cho thực phẩm",y="Tổng chi tiêu")

2.8 Phân tích sự ảnh hưởng tổng thu nhập lên tổng chi tiêu

2.8.1 Phân tích sự ảnh hưởng thu nhập lên tổng chi tiêu của các hộ gia đình

hq1 <- lm(TC~TT,BUK)
summary(hq1)

## 
## Call:
## lm(formula = TC ~ TT, data = BUK)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -277.791  -23.539   -6.713   13.287  234.718 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 55.44803    2.42313   22.88   <2e-16 ***
## TT           0.31743    0.01623   19.56   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 38.61 on 1517 degrees of freedom
## Multiple R-squared:  0.2014, Adjusted R-squared:  0.2008 
## F-statistic: 382.5 on 1 and 1517 DF,  p-value: < 2.2e-16

Mô hình hồi quy tuyến tính: TC = 55.44803 + 0.31743 TT

Hệ số hồi quy: Hệ số cho “TT” là 0.31743. Điều này nghĩa là, cho mỗi đơn vị tăng của “TT”, giá trị dự kiến cho “TC” tăng thêm 0.31743, giả sử tất cả các biến khác không thay đổi.

p-values cho cả hai hệ số đều rất nhỏ, điều này cho thấy cả hai hệ số đều có ý nghĩa thống kê.

R-squared: R-squared cho mô hình là 0.2014. Điều này có nghĩa là mô hình này giải thích được khoảng 20.14% sự biến động trong biến phụ thuộc “TC”.

F-statistic (Thống kê F): Giá trị thống kê F lớn (382.5) và giá trị p-value liên quan đến nó rất nhỏ (< 2.2e-16), cho thấy mô hình hồi quy này có ý nghĩa thống kê, tức là nó phù hợp với dữ liệu tốt hơn so với mô hình không có bất kỳ biến nào.

Tóm lại, dựa trên kết quả này, chúng ta có thể kết luận rằng “TT” có ảnh hưởng đáng kể đến “TC”. Tuy nhiên, mô hình này chỉ giải thích được khoảng 20.14% sự biến động trong “TC”, vì vậy có thể có các biến khác cũng ảnh hưởng đến “TC”.

• Đồ thị scatter plots

BUK %>% ggplot(aes(x = TT, y =TC )) +
  geom_point(color="purple") +
  geom_smooth(formula = y ~ x, method = "lm", color= "red") +
  xlab("Tổng thu nhập") +
  ylab("Tổng chi tiêu") +
  ggtitle("ĐỒ THỊ TỔNG THU NHẬP VÀ TỔNG CHI TIÊU CÁC HỘ GIA ĐÌNH")

2.8.2 Đồ thị scatter plots ảnh hưởng thu nhập lên chi tiêu của từ hộ gia đình theo nhóm tuổi

BUK %>% ggplot(aes(x=TT,y=TC))+
  geom_point(aes(color=Tcoded))+
  geom_smooth(aes(color=Tcoded),formula = y~x, method="lm")+
  xlab("Tổng thu nhập")+
  ylab("Tổng chi tiêu")+
  ggtitle("ĐỒ THỊ TỔNG THU NHẬP VÀ TỔNG CHI TIÊU CỦA TỪNG NHÓM TUỔI (2.3)")+
  facet_grid(.~Tcoded)

2.8.3 Đồ thị scatter plots ảnh hưởng thu nhập lên chi tiêu của từ hộ gia đình theo nhóm tuổi và có số con khác nhau

library(gridExtra)

g1 <- BUK %>% ggplot(aes(x=TT,y=TC))+
  geom_point(aes(color=Tcoded))+
  geom_point(data=BUK %>% filter(TE==2),size=2,color="yellow")+
  geom_smooth(aes(color=Tcoded),formula = y~x, method="lm")+
  facet_grid(.~Tcoded)
g2 <- BUK %>% ggplot(aes(x=TT,y=TC))+
  geom_point(aes(color=Tcoded))+
  geom_point(data=BUK %>% filter(TE==1),size=2,color="brown")+
  geom_smooth(aes(color=Tcoded),formula = y~x, method="lm")+
  facet_grid(.~Tcoded)
grid.arrange(g1, g2, nrow = 2, ncol = 1)

với g1 là vẽ các hộ gia đình màu vàng là các hộ gia đình có số con là 2, chia theo từng nhóm tuổi. Và g2 là các hộ gia đình với màu nâu là các hộ gia đình có số con là 1. Việc em thể hiện hai biểu đồ trên cùng một mảng hình để dễ dàng so sánh hơn nếu vẽ chồng lẫn lên nhau thì rất khó nhìn và khó nhận xét. Dựa vào đó ta có thể nhận xét được sự ảnh hưởng của thu nhập hộ gia đình của từng nhóm tuổi có số con trong gia đình khác nhau lên chi tiêu như thế nào mức độ phân tán của các điểm trên đồ thị.

2.9 Phân tích sự ảnh hưởng chi tiêu cho thực phẩm, quần áo, nhiên liệu,..lên tổng chi tiêu

• Dưới đây là mô hình hồi quy 4 biến lên tổng chi tiêu hộ gia đình bao gồm yếu tố thực phẩm, nhiên liệu, quần áo, phương tiện.

hq2 <- lm(TC~TP1+NL1+QA1+PT1,BUK)
summary(hq2)

## 
## Call:
## lm(formula = TC ~ TP1 + NL1 + QA1 + PT1, data = BUK)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -64.245 -12.055  -3.758   7.119 182.718 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  7.95069    1.59062   4.998 6.45e-07 ***
## TP1          1.46125    0.04393  33.262  < 2e-16 ***
## NL1          1.47733    0.09476  15.589  < 2e-16 ***
## QA1          1.28836    0.03645  35.344  < 2e-16 ***
## PT1          1.09603    0.03102  35.327  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 20.01 on 1514 degrees of freedom
## Multiple R-squared:  0.786,  Adjusted R-squared:  0.7855 
## F-statistic:  1390 on 4 and 1514 DF,  p-value: < 2.2e-16

Mô hình hồi quy tuyến tính: TC = 7.95069+ 1.46125TP1+ 1.47733NL1+ 1.28836QA1+ 1.09603PT1

Tất cả các biến độc lập đều có mối liên hệ đáng kể với biến phụ thuộc ‘TC’ (p-value < 0.001). Multiple R-squared và Adjusted R-squared đều là 0.786, cho thấy mô hình này giải thích được 78.6% biến động của biến phụ thuộc. Đây là một kết quả tốt và mô hình này có thể dự đoán ‘TC’ khá chính xác dựa trên các biến ‘TP1’, ‘NL1’, ‘QA1’, và ‘PT1’.

• Tạo biểu đồ chẩn đoán cho mô hình hồi quy.

par(mfrow=c(2,2))
plot(hq2)

2.10 Đồ thị hộp (Boxplots)

data <- BUK[,c("TP1")]
boxplot(data)

• Vẽ boxplot cho chi tiêu thực phẩm(TP1) theo cả ba nhóm tuổi là nhóm trẻ tuổi, trung niên và cao tuổi.

ggplot(BUK, aes(Tcoded, TP1, colour = Tcoded)) + geom_boxplot(show.legend = F)

Biểu đồ hộp cho ta biết được tứ phân vị, các điểm ngoại lai, dự đoán được xem có phân phối chuẩn hay không. Nghĩa là chúng ta sẽ có 50% số quan sát nằm trong khoảng từ phân vị thứ nhất Q1 đến phân vị thứ ba Q3 . Còn Q2 chính là trung vị (median). Nếu Q2 – Q1 > Q3 – Q2 thì phân phối sẽ méo về phía dương (positive skewness) và ngược lại. Nếu Q2 nằm chính giữa thì chúng ta có phân phối chuẩn.ví dụ trên ta có thể đọc được mức chi tiêu trung bình dành cho thực phẩm ở nhóm cao tuổi là cao nhất, ở nhóm trẻ tuổi là thấp nhất. Ở nhóm cao tuổi sẽ có phân phối méo về phía dương. Và nhóm trẻ tuổi gần như là có phân phối chuẩn.

3 TUẦN 4

Package: Ecdat - Datasets: BudgetUK(Budget Shares of British Household

Mô tả dữ liệu

Số quan sát : 1519

Quan sát : Hộ gia đình

Quốc gia : Vương quốc Anh

Dữ liệu có chứa :

1. wfood: tỷ lệ chi tiêu ngân sách dành cho thực phẩm.

2. wfuel: tỷ lệ chi tiêu ngân sách dành cho chi phí nhiên liệu

3. wcloth: tỷ lệ chi tiêu ngân sách dành cho quần áo thời trang

4. walc: tỷ lệ chi ngân sách chi cho rượu

5. wtrans: tỷ lệ chi tiêu ngân sách dành cho chi phí phương tiện, giao thông vận tải

6. wother: tỷ lệ chi tiêu ngân sách cho các yếu tố khác

7. totexp: tổng chi tiêu hộ gia đình (Được làm tròn đến số tiền gần nhất theo đơn vị 10 bảng Anh)

8. income: tổng thu nhập ròng của hộ gia đình (Được làm tròn đến số tiền gần nhất theo đơn vị 10 bảng Anh)

9. age: tuổi của chủ hộ

10. children: số con trong hộ gia đình

Đầu tiên, em sẽ thao tác gọi các packages cần thiết để làm báo cáo

library(tidyverse)
library(DT)
library(Ecdat)
library(ggplot2)
library(scales)
library(utf8)

Tiếp theo, em sẽ thao tác lấy dữ liệu gán vào bộ dữ liệu mới có tên là BUK, sau đó dùng lệnh datatable để xem dữ liệu.

BUK <- BudgetUK
str(BUK)

## 'data.frame':    1519 obs. of  10 variables:
##  $ wfood   : num  0.427 0.374 0.194 0.444 0.333 ...
##  $ wfuel   : num  0.1342 0.1686 0.4056 0.1258 0.0824 ...
##  $ wcloth  : num  0 0.0091 0.0012 0.0539 0.0399 ...
##  $ walc    : num  0.0106 0.0825 0.0513 0.0397 0.1571 ...
##  $ wtrans  : num  0.1458 0.1215 0.2063 0.0652 0.2403 ...
##  $ wother  : num  0.282 0.244 0.141 0.272 0.147 ...
##  $ totexp  : num  50 90 180 80 90 70 140 50 100 90 ...
##  $ income  : num  130 150 230 100 100 70 190 100 260 110 ...
##  $ age     : num  25 39 47 33 31 24 46 25 30 41 ...
##  $ children: num  2 2 2 2 1 1 1 1 1 1 ...

datatable(BUK,options = list(scrollX = TRUE))

Để thao tác trên các biến, cũng như các tuần trước em thực hiện đổi tên lại mục đích là làm cho các biến gọn gàng và dễ thực hiện hơn: wfood = ‘TP’, wfuel = ‘NL’, wcloth = ‘QA’, walc =‘R’, wtrans = ‘PT’, wother = ‘K’, totexp = ‘TC’, income = ‘TT’, age = ‘T’, children = ‘TE’. Và thêm một cột biến mới vào dữ liệu bằng cách, phân tổ biến tuổi của chủ hộ gia đình 3 tổ (độ tuổi [19-30] gọi là trẻ tuổi, độ tuổi (30-50] gọi là trung niên, độ tuổi (50-60] gọi là cao tuổi). Ngoài ra, em còn biến đổi thêm các cột mới như là TP1, NL1, QA1, R1, PT1, K1 chính là các mức tiền chi tiêu cho thực phẩm, nhiên liệu, quần áo, rượu, phương tiện và các chi tiêu khác bằng cách lấy tỉ lệ % ban đầu mà bộ data cung cấp nhân cho tổng chi tiêu.

names(BUK) <- c("TP","NL","QA","R","PT","K","TC","TT","T","TE")
BUK$Tcoded <- cut(BUK$T, breaks=c(18.95,30,50,60), labels=c("trẻ tuổi","trung niên","cao tuổi"))
BUK <- BUK %>% mutate(across(c(TP, NL, QA, R, PT, K),~ . * TC,.names = "{.col}1"))
datatable(BUK,options = list(scrollX = TRUE))

3.1 Lập bảng tần số, tần suất giữa hai biến và vẽ biểu đồ

3.1.1 Biến tuổi chủ hộ gia đình (Tcoded)

table(BUK$Tcoded)

## 
##   trẻ tuổi trung niên   cao tuổi 
##        400       1046         73

prop.table(table(BUK$Tcoded))

## 
##   trẻ tuổi trung niên   cao tuổi 
## 0.26333114 0.68861093 0.04805793

Bảng tần số trên cho thấy là trong tổng số 1519 hộ gia đình thì có 400 chủ hộ gia đình thuộc nhóm trẻ tuổi chiếm gần 26%, có 1046 chủ hộ thuộc nhóm tuổi trung niên chiếm 69%, có 73 chủ hộ thuộc nhóm cao tuổi chiếm xấp xỉ 5%. Bên dưới là đồ thị cột biểu diễn cho bảng tần số và bảng tần suất này.

BUK %>% 
  ggplot(aes(Tcoded)) +
  geom_bar(fill = "purple") +
  geom_text(aes(label = scales::percent(after_stat(count / sum(count)))), stat = "count", color = "red",vjust = -0.5) +
  theme_classic() +
  labs(x = "Nhóm tuổi", y = "Số hộ gia đình", title="Đồ thị phân bố nhóm tuổi chủ hộ gia đình")

Có thể vẽ đồ thị tròn để biểu diễn các nhóm tuổi.

BUK_summary <- BUK %>%
  group_by(Tcoded) %>%
  summarise(n = n()) %>%
  mutate(percentage = n/sum(n))
ggplot(BUK_summary, aes(x = "", y = percentage, fill = Tcoded)) +
  geom_bar(stat = "identity", width = 1) +
  geom_text(aes(label = paste0(round(percentage*100), "%")), position = position_stack(vjust = 0.5))+
  coord_polar("y", start = 0) +
  scale_fill_manual(values = c("skyblue", "purple", "pink"), name = "Nhóm tuổi") +
  labs(title = "BIỂU ĐỒ PHÂN BỐ NHÓM TUỔI") +
  theme_minimal() +
  theme(legend.position = "bottom")

3.1.2 Biến số con trong hộ gia đình (TE) và biến tuổi chủ hộ gia đình (Tcoded)

table(BUK$TE,BUK$Tcoded)

##    
##     trẻ tuổi trung niên cao tuổi
##   1      215        330       49
##   2      185        716       24

prop.table(table(BUK$TE,BUK$Tcoded))

##    
##       trẻ tuổi trung niên   cao tuổi
##   1 0.14154049 0.21724819 0.03225806
##   2 0.12179065 0.47136274 0.01579987

Bảng tần số và tần suất hai biến tuổi chủ hộ gia đình và số con trong một gia đình, hai bảng này cho thấy trong 1519 quan sát thì, trong nhóm hộ gia đình có chủ hộ thuộc nhóm trẻ tuổi có 215 hộ gia đình có số con là 1 (chiếm 14.15%) và có 185 hộ gia đình có số con là 2 (chiếm 12.18%), trong nhóm hộ gia đình trung niên thì có 330 hộ gia đình có số con là 1 (chiếm 21.72%) và có 716 hộ gia đình có số con là 2 chiếm 47.14%, trong nhóm hộ gia đình có chủ hộ thuộc nhóm cao tuổi thì có 49 hộ gia đình có số con là 1 chiếm 3.23% và có 24 hộ gia đình có số con là 2 chiếm 1.58%.

df <- BUK %>% count(Tcoded,TE) %>% mutate(pc=prop.table(n))
ggplot(df, aes(x = Tcoded, y = n, fill = factor(TE))) +
  geom_col(position = "dodge") +
  geom_text(aes(label=percent(pc, accuracy = .01)), position = position_dodge(1), vjust = -.5, size = 3)+
  labs(title = "Biểu đồ cột đôi",
       x = "Nhóm tuổi",
       y = "Số lượng",
       fill = "TE") +
  theme_minimal()

3.2 Lọc dữ liệu

3.2.1 Tìm số hộ gia đình có chi tiêu nhỏ hơn thu nhập và có số con trong gia đình là 1

ss <- BUK[BUK$TC<BUK$TT&BUK$TE==1,]
datatable(ss,options = list(scrollX = TRUE))

Từ cái em mới lọc được em sẽ lập bảng tần số cho dữ liệu này

table(ss$Tcoded,ss$TE)

##             
##                1
##   trẻ tuổi   175
##   trung niên 279
##   cao tuổi    36

prop.table(table(ss$Tcoded,ss$TE))

##             
##                       1
##   trẻ tuổi   0.35714286
##   trung niên 0.56938776
##   cao tuổi   0.07346939

Số hộ gia đình có thu nhập lớn hơn tổng chi tiêu và có số con trong gia đình bằng 1: thuộc nhóm trẻ tuổi có 175 hộ chiếm 35.71%, số hộ gia đình thuộc nhóm trung niên là 279 chiếm 56.93% cao nhất và thuộc nhóm cao tuổi có 36 hộ gia đình chiếm 7.35%.

Đồ thị bên dưới biểu diễn số hộ gia đình có thu nhập lớn hơn chi tiêu và có số con là 1.

ss %>% 
  ggplot(aes(Tcoded)) +
  geom_bar(fill = "purple") +
  geom_text(aes(label = scales::percent(after_stat(count / sum(count)))), stat = "count", color = "red",vjust = -0.5) +
  theme_classic() +
  labs(x = "Nhóm tuổi", y = "Số hộ gia đình", title="Đồ thị số hộ gia đình có thu nhập lớn hơn chi tiêu (SỐ CON 1)")

3.2.2 Tìm số hộ gia đình có chi tiêu lớn hơn thu nhập hoặc số con trong hộ gia đình không phải là 1

ss2 <- BUK[BUK$TC>BUK$TT|!BUK$TE==1,]
table(ss2$Tcoded)

## 
##   trẻ tuổi trung niên   cao tuổi 
##        210        753         34

prop.table(table(ss2$Tcoded))

## 
##   trẻ tuổi trung niên   cao tuổi 
## 0.21063190 0.75526580 0.03410231

Có 210 hộ gia đình thuộc nhóm trẻ tuổi có chi tiêu lớn hơn thu nhập và có số con trong gia đình là 2 chiếm 21.06%; tương tự thì có 753 hộ thuộc nhóm tuổi trung niên chiếm 75.53%; và hộ gia đình cao tuổi có 34 hộ chiếm 3.41%.

ss2 %>% 
  ggplot(aes(Tcoded)) +
  geom_bar(fill = "purple") +
  geom_text(aes(label = scales::percent(after_stat(count / sum(count)))), stat = "count", color = "red",vjust = -0.5) +
  theme_classic() +
  labs(x = "Nhóm tuổi", y = "Số hộ gia đình", title="Đồ thị phân bố nhóm tuổi chủ hộ gia đình có chi tiêu lớn hơn thu nhập (số con 2)")

3.2.3 Tìm số hộ gia đình có chi tiêu lớn hơn thu nhập

ss3 <- BUK[BUK$TC>BUK$TT,]
tmp <- table(ss3$TE,ss3$Tcoded)
addmargins(tmp)

##      
##       trẻ tuổi trung niên cao tuổi Sum
##   1         25         37       10  72
##   2         35        100        8 143
##   Sum       60        137       18 215

prop.table(table(ss3$TE,ss3$Tcoded))

##    
##       trẻ tuổi trung niên   cao tuổi
##   1 0.11627907 0.17209302 0.04651163
##   2 0.16279070 0.46511628 0.03720930

df <- ss3 %>% count(Tcoded,TE) %>% mutate(pc=prop.table(n))
ggplot(df, aes(x = Tcoded, y = n, fill = factor(TE))) +
  geom_col(position = "dodge") +
  geom_text(aes(label=percent(pc, accuracy = .01)), position = position_dodge(1), vjust = -.5, size = 3)+
  labs(title = "Biểu đồ cột đôi",
       x = "Nhóm tuổi",
       y = "Số lượng",
       fill = "TE") +
  theme_minimal()

Nhìn vào bảng tần số trên ta có thể đọc được kết quả như sau: có 215 hộ gia đình có chi tiêu lớn hơn thu nhập và chi tiết là trong 60 hộ gia đình trẻ tuổi thì số hộ gia đình có 1 con có 25 hộ chiếm 11.63%, còn lại là 35 hộ gia đình trẻ tuổi có 2 con chiếm 16.28%; trong 137 hộ gia đình trung niên thì có 37 hộ gia đình có 1 con chiếm 17.21%, có 100 hộ có số con là 2 chiếm 46.51%; trong 18 hộ gia đình cao tuổi thì có 10 hộ có 1 con chiếm 4.65%, có 8 hộ gia đình có 2 con chiếm 3.72%.

3.3 Thống kê mô tả

3.3.1 Lệnh summary

summary(BUK)

##        TP               NL                QA                R          
##  Min.   :0.0571   Min.   :0.00000   Min.   :0.00000   Min.   :0.00000  
##  1st Qu.:0.2817   1st Qu.:0.05530   1st Qu.:0.03215   1st Qu.:0.01255  
##  Median :0.3540   Median :0.08000   Median :0.08570   Median :0.04230  
##  Mean   :0.3565   Mean   :0.09101   Mean   :0.10723   Mean   :0.06060  
##  3rd Qu.:0.4258   3rd Qu.:0.11365   3rd Qu.:0.15825   3rd Qu.:0.08995  
##  Max.   :0.7890   Max.   :0.48030   Max.   :0.76020   Max.   :0.42810  
##        PT                K                TC              TT        
##  Min.   :0.00000   Min.   :0.0361   Min.   : 30.0   Min.   :  20.0  
##  1st Qu.:0.05695   1st Qu.:0.1785   1st Qu.: 70.0   1st Qu.: 100.0  
##  Median :0.11530   Median :0.2397   Median : 90.0   Median : 120.0  
##  Mean   :0.13235   Mean   :0.2523   Mean   : 98.7   Mean   : 136.2  
##  3rd Qu.:0.17940   3rd Qu.:0.3100   3rd Qu.:120.0   3rd Qu.: 160.0  
##  Max.   :0.76380   Max.   :0.8066   Max.   :390.0   Max.   :1110.0  
##        T               TE               Tcoded          TP1         
##  Min.   :19.00   Min.   :1.000   trẻ tuổi  : 400   Min.   :  5.095  
##  1st Qu.:30.00   1st Qu.:1.000   trung niên:1046   1st Qu.: 24.834  
##  Median :35.00   Median :2.000   cao tuổi  :  73   Median : 30.906  
##  Mean   :35.78   Mean   :1.609                     Mean   : 33.009  
##  3rd Qu.:40.00   3rd Qu.:2.000                     3rd Qu.: 38.720  
##  Max.   :60.00   Max.   :2.000                     Max.   :146.487  
##       NL1              QA1                R1              PT1        
##  Min.   : 0.000   Min.   :  0.000   Min.   : 0.000   Min.   :  0.00  
##  1st Qu.: 5.212   1st Qu.:  2.595   1st Qu.: 1.014   1st Qu.:  4.88  
##  Median : 7.217   Median :  7.678   Median : 3.864   Median : 10.29  
##  Mean   : 8.267   Mean   : 11.831   Mean   : 6.244   Mean   : 13.74  
##  3rd Qu.: 9.850   3rd Qu.: 16.256   3rd Qu.: 8.820   3rd Qu.: 16.96  
##  Max.   :74.412   Max.   :240.045   Max.   :70.452   Max.   :236.78  
##        K1        
##  Min.   :  1.98  
##  1st Qu.: 14.05  
##  Median : 20.59  
##  Mean   : 25.61  
##  3rd Qu.: 30.49  
##  Max.   :198.16

summary(BUK$T)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   19.00   30.00   35.00   35.78   40.00   60.00

summary(BUK$TT)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    20.0   100.0   120.0   136.2   160.0  1110.0

summary(BUK$TC)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    30.0    70.0    90.0    98.7   120.0   390.0

Lệnh summary cho ta bảng tóm tắt về trung bình, trung vị, tứ phân vị, min và max của từ cột dữ liệu:

Khi thực hiện dòng lệnh summary(BUK$TT) ta thu được giá trị nhỏ nhất của tổng thu nhập trong các hộ gia đình là 20, giá trị lớn nhất là 1110, mức trung bình là 136.2, có 25% số hộ gia đình có mức thu nhập nhỏ hơn 100, có 50 % số hộ gia đình có mức thu nhập dưới 120 và có 75% số hộ gia đình có mức thu nhập nhỏnhỏ hơn 160 (tính theo đơn vị 10 bảng Anh gần nhất).

Tương tự, dòng lệnh summary(BUK$TC) cho ta biết được hộ gia đình có mức chi tiêu nhỏ nhất là 30, hộ gia đình có mức chi tiêu lớn nhất là 390, mức chi tiêu trung bình là 98.7, có 25% số hộ gia đình chi tiêu dưới 70, có 50% số hộ gia đình có mức chi tiêu dưới 90 và có 75% số hộ gia đình có mức chi tiêu dưới 120(tính theo đơn vị 10 bảng Anh gần nhất).

Độ tuổi chủ hộ gia đình trong quan sát nhỏ nhất là 19, lớn nhất là 60, có 25% số người chủ hộ gia đình nhỏ hơn 30 tuổi có 50% số chủ hộ gia đình nhỏ hơn 35 tuổi, có 75% số người chủ hộ gia đình nhỏ hơn 40 tuổi. Độ tuổi trung bình trong khảo sát là 35.78~36. Số con trong hộ gia đình có nhiều nhất 2 con và ít nhất 1 con.

Ngoài ra, ta còn có thể đọc tương tự cho các biến có trong dữ liệu trên cho từng mức chi tiêu cho thực phẩm, quần áo,…

3.3.2 Hàm aggregate - Toán tử %>%

aggregate(BUK$TP1,list(BUK$Tcoded),FUN ='mean')

##      Group.1        x
## 1   trẻ tuổi 28.77565
## 2 trung niên 34.33578
## 3   cao tuổi 37.19184

Hàm trên trả cho ta kết quả về mức chi tiêu trung bình dành cho thực phẩm ở các nhóm tuổi, ở nhóm trẻ tuổi thì mức chi tiêu trung bình dành cho thực phẩm là 28.78 tính theo bảng Anh, ở nhóm tung niên thì mức chi tiêu trung bình dành cho thực phẩm là 34.34, ở nhóm cao tuổi thì mức chi tiêu trung bình cho thực phẩm là 37.19 bảng Anh. Qua đó ta có thể nhận xét, ở nhóm cao tuổi thì mức chi tiêu trung bình dành cho thực phẩm ở nhóm cao tuổi là cao nhất và thấp nhất ở nhóm trẻ tuổi.

aggregate(BUK$TP1,list(BUK$Tcoded),FUN ='max')

##      Group.1       x
## 1   trẻ tuổi  85.320
## 2 trung niên  90.540
## 3   cao tuổi 146.487

Ở câu lệnh trên thì sẽ cho ta kết quả về mức chi tiêu cao nhất dành cho thực phẩm (Tính theo bảng Anh) phân theo nhóm tuổi ở nhóm trẻ tuổi thì hộ gia đình có mức chi tiêu cao nhất dành cho thực phẩm là 85.32, ở nhóm trung niên thì hộ gia đình có mức chi tiêu cao nhất dành cho thực phẩm là 90.54, ở nhóm cao tuổi thì hộ gia đình có mức chi tiêu cao nhất dành cho thực phẩm là 146.487.

BUK %>% group_by(Tcoded) %>% summarise_at(c("TP1","QA1","R1"),list(n=mean))

## # A tibble: 3 × 4
##   Tcoded     TP1_n QA1_n  R1_n
##   <fct>      <dbl> <dbl> <dbl>
## 1 trẻ tuổi    28.8  9.80  6.73
## 2 trung niên  34.3 12.5   6.10
## 3 cao tuổi    37.2 12.9   5.58

Ngoài ra, em có dùng toán tử %>% và summarise_at để tính tổng hợp mức chi tiêu trung bình cho từng yếu tố như là thực phẩm, quần áo, hay là rượu hay rất nhiều yếu tố còn lại dữ liệu. giờ em muốn so sánh mức chi tiêu trung bình của ba cái như là thực phẩm, quần áo và rượu thì em nhận thấy mức chi tiêu trung bình cho thực phẩm là cao nhất ở từng nhóm tuổi.

3.3.3 Các hàm mean() tính trung bình, var() phương sai, quantile()

mean(BUK$TP1)

## [1] 33.00888

mean(BUK$QA1)

## [1] 11.83112

Ngân sách chi tiêu trung bình của các hộ gia đình dành cho thực phẩm là 33.00888. Chi tiêu trung bình dành cho quần áo là 11.83112

var (BUK$NL1)

## [1] 30.25756

var(BUK$R1)

## [1] 57.5824

sd(BUK$K1)

## [1] 18.86031

30.25756 đại diện cho mức độ phân tán của các giá trị chi tiêu ngân sách cho yếu tố nhiên liệu quanh giá trị trung bình; 57.5824 đại diện cho mức độ phân tán của các giá trị chi tiêu ngân sách cho yếu tố rượu quanh giá trị trung bình; 18.86031: Độ lệch chuẩn đo lường mức độ phân tán của các giá trị của biến K1( chi tiêu cho các yếu tố khác) trong tập dữ liệu.

quantile(BUK$PT1,0.45)

##    45% 
## 9.2719

quantile(BUK$K1,0.57)

##      57% 
## 22.60134

Có 45% hộ gia đình có mức chi tiêu ngân sách cho phương tiện dưới mức 9.2719. có 57% hộ gia đình có mức ngân sách dành cho các chi tiêu khác dưới 22.60134

3.4 Phân tích sự ảnh hưởng tổng thu nhập lên tổng chi tiêu của từng nhóm tuổi, hồi quy hai biến

bu <- BUK %>% group_by(Tcoded) %>% summarise(TC_mean=mean(TC),TT_mean=mean(TT))
bu

## # A tibble: 3 × 3
##   Tcoded     TC_mean TT_mean
##   <fct>        <dbl>   <dbl>
## 1 trẻ tuổi      84.6    112.
## 2 trung niên   104.     145.
## 3 cao tuổi     105.     139.

tct <- aov(TC ~ Tcoded, data = BUK)
summary(tct)

##               Df  Sum Sq Mean Sq F value   Pr(>F)    
## Tcoded         2  108099   54050   30.08 1.54e-13 ***
## Residuals   1516 2723920    1797                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

ttt <- aov(TT ~ Tcoded, data = BUK)
summary(ttt)

##               Df  Sum Sq Mean Sq F value Pr(>F)    
## Tcoded         2  310959  155479   44.07 <2e-16 ***
## Residuals   1516 5348852    3528                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Từ đó, ta nhận xét được Pr(>F): giá trị p-value là 1.54e-13 và <2e-16, rất nhỏ hơn mức ý nghĩa thông thường 0.05. Điều này cho thấy có sự khác biệt đáng kể giữa chi tiêu và thu nhập các nhóm tuổi trong biến “Tcoded”. Mức chi tiêu trung bình của các nhóm tuổi có xu hướng tăng dần từ nhóm trẻ tuổi đến nhóm trung niên và nhóm cao tuổi( người trẻ tuổi có chi tiêu trung bình là 84,6 thấp nhất và cao nhất là người cao tuổi 105,3425). Tuy nhiên, mức thu nhập trung bình có sự biến động khác nhau giữa các nhóm tuổi, ngươì có độ tuổi trung niên có trung bình tổng thu nhập cao nhất.

ggplot(bu) +
  geom_col(aes(x = Tcoded, y = TT_mean, fill = "Thu nhập"), position = "dodge") +
  geom_col(aes(x = Tcoded, y = TC_mean, fill = "Chi tiêu"), position = "dodge") +
  labs(x = "Nhóm", y = "Giá trị") +
  ggtitle("Mức chi tiêu và thu nhập trung bình giữa các nhóm tuổi") +
  scale_fill_manual(values = c("Chi tiêu" = "pink", "Thu nhập" = "gray")) +
  theme_minimal()

u <- lm(BUK$TC~BUK$TT)
summary(u)

## 
## Call:
## lm(formula = BUK$TC ~ BUK$TT)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -277.791  -23.539   -6.713   13.287  234.718 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 55.44803    2.42313   22.88   <2e-16 ***
## BUK$TT       0.31743    0.01623   19.56   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 38.61 on 1517 degrees of freedom
## Multiple R-squared:  0.2014, Adjusted R-squared:  0.2008 
## F-statistic: 382.5 on 1 and 1517 DF,  p-value: < 2.2e-16

Từ kết quả bảng hồi quy trên, ta thấy TC=55.44803+0.31743TT. Multiple R-squared: 0.2014, sự thay đổi tổng thu nhập giải thích xấp xỉ 20.14% sự thay đổi tổng chi tiêu. F-statistic: 382.5 on 1 and 1517 DF, p-value: < 2.2e-16. cho thấy mô hình này có ý nghĩa hồi quy. Bên dưới là đồ thị phân tán diễn tả sự phụ thuộc chi tiêu lên thu nhập ở từng nhóm tuổi.

BUK %>% ggplot(aes(x = TT, y =TC )) +
  geom_point(color="skyblue") +
  geom_smooth(formula = y ~ x, method = "lm", color= "red") +
  xlab("Tổng thu nhập") +
  ylab("Tổng chi tiêu") +
  ggtitle("ĐỒ THỊ TỔNG THU NHẬP VÀ TỔNG CHI TIÊU CÁC HỘ GIA ĐÌNH")

cor(BUK$TT,BUK$TC)

## [1] 0.4487403

Nhận xét đồ thị trên: Đường hồi quy dốc và thẳng cho thấy có mối quan hệ tuyến tính giữa hai biến này, xu hướng khi tổng thu nhập tăng lên thì tổng chi tiêu của một số hộ gia đình tăng theo. Khi tính hệ số tương quan hai biến là 0.4487403 mức tương quan này tương đối thấp và nó cũng được thể hiện qua việc tập trung các điểm dày đặc ở phần đầu đường hồi quy.

Ngoài ra, có thể chia ra sự phụ thuộc thu nhập và chi tiêu ở từng nhóm tuổi riêng biệt.

BUK %>% ggplot(aes(x=TT,y=TC))+
  geom_point(aes(color=Tcoded))+
  geom_smooth(aes(color=Tcoded),formula = y~x, method="lm")+
  xlab("Tổng thu nhập")+
  ylab("Tổng chi tiêu")+
  ggtitle("ĐỒ THỊ TỔNG THU NHẬP VÀ TỔNG CHI TIÊU CỦA TỪNG NHÓM TUỔI (2.3)")+
  facet_grid(.~Tcoded)

Nhận xét: Đồ thị trên cũng gần như cho thấy các đường hổi quy giữa tổng thu nhập và tổng chi tiêu ở từng nhóm tuổi có độ dốc dương thì cho thấy sự tương quan dương giữa hai biến này có nghĩa là ở các nhóm tuổi khi thu nhập tăng thì chi tiêu cũng tăng theo. Và để có thể chắc chắn kết luận trên thì ta cần phải đi tính hệ số tương quan cũng như là kiểm định sự phù hợp mô hình trên.

3.5 TRỰC QUAN HÓA DỮ LIỆU

3.5.1 Đồ thị phân tán (Scatter plot)

Biểu đồ phân tán thể hiện mối quan hệ giữa tổng thu nhập và tổng chi tiêu - Bên dưới là em vẽ đồ thị phân tán có vẽ đường hồi quy giữa hai biến tổng thu nhập và tổng chi tiêu có đường hồi quy của các hộ gia đình, với trục hoành là biến tổng thu nhập và trục tung là biến tổng chi tiêu mỗi điểm là đại diện cho một giá trị của hộ gia đình.

BUK %>% ggplot(aes(x = TT, y =TC )) +
  geom_point(color="skyblue") +
  geom_smooth(formula = y ~ x, method = "lm", color= "red") +
  xlab("Tổng thu nhập") +
  ylab("Tổng chi tiêu") +
  ggtitle("ĐỒ THỊ TỔNG THU NHẬP VÀ TỔNG CHI TIÊU CÁC HỘ GIA ĐÌNH")

cor(BUK$TT,BUK$TC)

## [1] 0.4487403

Nhận xét đồ thị trên: Đường hồi quy dốc và thẳng cho thấy có mối quan hệ tuyến tính giữa hai biến này, xu hướng khi tổng thu nhập tăng lên thì tổng chi tiêu của một số hộ gia đình tăng theo. Khi tính hệ số tương quan hai biến là 0.4487403 mức tương quan này tương đối thấp và nó cũng được thể hiện qua việc tập trung các điểm dày đặc ở phần đầu đường hồi quy.

Đồ thị scatter cho tổng thu nhập và chi tiêu dựa trên từng nhóm tuổi

• Đồ thị phân tán nhưng biểu hiện không phải bằng điểm và thay vào đó là các hình học (shape)

BUK %>% ggplot(aes(x=TT,y=TC,shape=Tcoded))+
  geom_point(color="blue",size=2)+
  labs(x="Tổng thu nhập",y="Tổng chi tiêu",title="ĐỒ THỊ TỔNG THU NHẬP VÀ TỔNG CHI TIÊU THEO NHÓM TUỔI ( Shape)")

Nhận xét: Đồ thị biểu thị các chấm tròn là thuộc nhóm trẻ tuổi, hình tam giác là độ tuổi trung niên, và ô vuông là nhóm cao tuổi. Để nhận xét chi tiết sự phụ thuộc của chi tiêu vào thu nhập của từng nhóm thì ta cần vẽ thêm đường hồi quy.

• Đồ thị bên dưới thể hiện tổng chi tiêu và tổng thu nhập của hộ gia đình theo từng nhóm tuổi bằng các điểm mà không có đường hồi quy:

BUK %>% ggplot(aes(x=TT,y=TC))+
  geom_point(aes(color=Tcoded))+
  xlab("Tổng thu nhập")+
  ylab("Tổng chi tiêu")+
  ggtitle("ĐỒ THỊ TỔNG THU NHẬP VÀ TỔNG CHI TIÊU THEO NHÓM TUỔI (2.1)")

Nhận xét: Đồ thị bên trên chia màu theo nhóm tuổi với màu đỏ biểu thị cho chủ hộ gia đình thuộc nhóm trẻ tuổi, màu xanh lá thể hiện chủ hộ có tuổi thuộc nhóm trung niên và màu xanh dương thuộc nhóm cao tuổi, nhìn vào đồ thị trên ta thấy mức độ không đồng đều trong các nhóm tuổi, màu xanh lá của nhóm tuổi trung niên chiếm số đông trong bộ dữ liệu.

• Tương tự như đồ thị trên, thì đồ thị bên dưới chính là hình ảnh mô tả tổng chi tiêu và thu nhập hộ gia đình theo từng nhóm tuổi, nhưng để thể hiện rõ mối quan hệ thì em vẽ thêm đường hồi quy cho hai biến này:

BUK %>% ggplot(aes(x=TT,y=TC,color=Tcoded))+
  geom_point()+
  geom_smooth(aes(color=Tcoded),formula = y~x,method="lm")+
  xlab("Tổng thu nhập")+
  ylab("Tổng chi tiêu")+
  ggtitle("ĐỒ THỊ TỔNG THU NHẬP VÀ TỔNG CHI TIÊU THEO NHÓM TUỔI (2.2)")

Nhận xét: So với cùng một mức thu nhập thì nhóm người cao tuổi và trung niên có mức chi tiêu cao hơn. Ở các nhóm tuổi, các đường hổi quy có độ dốc tương tự nhau, và có mổi quan hệ tuyến tính giữa tổng chi tiêu và tổng thu nhập. Tuy nhiên, ở nhóm tuổi trung niên thì mối quan hệ tuyến tính này cao hơn vì đường hồi quy dốc hơn. Để nhận xét cụ thể thì ta có thể vẽ riêng sự phụ thuộc biến thu nhập và tổng chi tiêu theo từng nhóm tuổi.

• Đồ thị phân tán có đường hồi quy giữa biến tổng thu nhập và tổng chi tiêu nhưng chia ra từng phần cho từng nhóm tuổi.

BUK %>% ggplot(aes(x=TT,y=TC))+
  geom_point(aes(color=Tcoded))+
  geom_smooth(aes(color=Tcoded),formula = y~x, method="lm")+
  xlab("Tổng thu nhập")+
  ylab("Tổng chi tiêu")+
  ggtitle("ĐỒ THỊ TỔNG THU NHẬP VÀ TỔNG CHI TIÊU CỦA TỪNG NHÓM TUỔI (2.3)")+
  facet_grid(.~Tcoded)

Nhận xét: Đồ thị trên cũng gần như cho thấy các đường hổi quy giữa tổng thu nhập và tổng chi tiêu ở từng nhóm tuổi có độ dốc dương thì cho thấy sự tương quan dương giữa hai biến này có nghĩa là ở các nhóm tuổi khi thu nhập tăng thì chi tiêu cũng tăng theo. Và để có thể chắc chắn kết luận trên thì ta cần phải đi tính hệ số tương quan cũng như là kiểm định sự phù hợp mô hình trên.

• Đồ thị dạng ngang nhưng thay đổi cách vẽ đường hồi quy y= x+ sqrt(x)

BUK %>% ggplot(aes(x=TT,y=TC))+
  geom_point(aes(color=Tcoded))+
  geom_smooth(aes(color=Tcoded),formula = y~x+sqrt(x),method="lm")+
  labs(x="Tổng thu nhập",y="Tổng chi tiêu")+
  ggtitle("ĐỒ THỊ TỔNG THU NHẬP VÀ TỔNG CHI TIÊU CỦA TỪNG NHÓM TUỔI (2.4)")+
  facet_grid(Tcoded~.)

Nhận xét: khi thay đổi hình dạng đường hồi quy thì em thấy được sự phân bố các hộ gia đình này xung quanh đường hồi quy đều hơn và không có sự chênh lệch lớn so với đường hồi quy tuyến tính. Hoặc có thể thấy mô hình này giải thích được sự phụ thuộc biến chi tiêu vào biến thu nhập nhiều hơn.

Đồ thị scatter tổng thu nhập và chi tiêu cho từng nhóm tuổi và lọc theo số con trong hộ gia đình

• Đồ thị này sẽ chỉ vẽ tổng chi tiêu và thu nhập của các nhóm tuổi và có số con là 2 trong hộ gia đình.

BUK %>% filter(TE=="2") %>%  ggplot(aes(x=TT,y=TC))+
  geom_point(aes(color=Tcoded))+
  geom_smooth(aes(color=Tcoded),formula = y~x, method="lm")+
  xlab("Tổng thu nhập")+
  ylab("Tổng chi tiêu")+
  ggtitle("ĐỒ THỊ TỔNG THU NHẬP VÀ CHI TIÊU TỪNG NHÓM TUỔI (SỐ CON: 2)")+
  facet_grid(.~Tcoded)

Nhận xét: Đồ thị trên sẽ lọc ra các hộ gia đình có số con là 2 để vẽ, nhìn đồ thị ta có thể nhận thấy là ở nhóm tuổi trung niên có số con là 2 phân tán dày đặc hơn, tiếp theo là màu đỏ thì nhóm trẻ tuổi. Tuy nhiên, các đường hồi quy, sự phụ thuộc tổng chi tiêu vào tổng thu nhập có độ dốc tương đương nhau, điều biểu thị sự tương quan thuận, nghĩa là ở các nhóm tuổi có số con là 2 khi thu nhập tăng thì tổng chi tiêu cũng tăng theo.

• Đồ thị chỉ vẽ mối quan hệ giữa chi tiêu và thu nhập của các hộ gia đình có số con là 1.

BUK %>% filter(TE==1) %>%  ggplot(aes(x=TT,y=TC))+
  geom_point(aes(color=Tcoded))+
  geom_smooth(aes(color=Tcoded),formula = y~x, method="lm")+
  xlab("Tổng thu nhập")+
  ylab("Tổng chi tiêu")+
  ggtitle("ĐỒ THỊ TỔNG THU NHẬP VÀ CHI TIÊU TỪNG NHÓM TUỔI (SỐ CON: 1)")+
  facet_grid(.~Tcoded)

• Đồ thị bên dưới sẽ vẽ tương tự như phía trên nhưng các hộ gia đình có số con bằng 2 sẽ được vẽ đè lên lớp cũ, có nghĩa là các hộ gia đình có 2 con hay 1 con vẫn được vẽ sau đó mới lọc gia đình có hai con vẽ lên lớp trên. Thay vì lọc ra số hộ gia đình có 2 con rồi mới vẽ thì ta sẽ không nhìn được tổng quan được.

BUK %>% ggplot(aes(x=TT,y=TC))+
  geom_point(aes(shape=Tcoded),size=3,color="blue")+
  geom_point(data=BUK %>% filter(TE==2),size=3,color="red")+
  labs(x="Tổng thu nhập",y="Tổng chi tiêu")+
  ggtitle("ĐỒ THỊ TỔNG THU NHẬP TỔNG CHI TIÊU(SỐ CON:2)")

Tương tự thì ta có thể vẽ các hộ gia đình có số con bằng 1 để quan sát.

BUK %>% ggplot(aes(x=TT,y=TC))+
  geom_point(aes(shape=Tcoded),color="blue",size=3)+
  geom_point(data=BUK %>% filter(TE==1),color="yellow", size=3)+
  labs(x="Tổng thu nhập",y="Tổng chi tiêu")+
  ggtitle("ĐỒ THỊ TỔNG THU NHẬP TỔNG CHI TIÊU")

Hoặc để nhìn dễ hơn thì ta có thể sử dụng gói gridExtra hiển thị đồng thời hai graphs trên một cửa sổ hiển thị.

library(gridExtra)

g1 <- BUK %>% ggplot(aes(x=TT,y=TC))+
  geom_point(aes(shape=Tcoded),size=3,color="blue")+
  geom_point(data=BUK %>% filter(TE==2),size=3,color="red")+
  labs(x="Tổng thu nhập",y="Tổng chi tiêu")+
  ggtitle("ĐỒ THỊ TỔNG THU NHẬP TỔNG CHI TIÊU(SỐ CON:2)")
g2 <- BUK %>% ggplot(aes(x=TT,y=TC))+
  geom_point(aes(shape=Tcoded),color="blue",size=3)+
  geom_point(data=BUK %>% filter(TE==1),color="yellow", size=3)+
  labs(x="Tổng thu nhập",y="Tổng chi tiêu")+
  ggtitle("ĐỒ THỊ TỔNG THU NHẬP TỔNG CHI TIÊU(SỐ CON:1)")
grid.arrange(g1, g2, nrow = 2, ncol = 1)

Lệnh grid.arrange(g1, g2, nrow = 2, ncol = 1): Hiển thị g1, g2 theo hai hàng một cột. Qua đó ta nhận xét rằng số hộ gia đình có hai con phân bố nhiều hơn, tuy nhiên ở hai nhóm này có hình dạng phân bố giống nhau.

Đồ thị scatter giữa chi tiêu cho thức ăn và tổng chi tiêu

• Đồ thị phân tán biểu diễn sự phụ thuộc của biến tổng chi tiêu vào biến chi tiêu cho thực phẩm (không có đường hồi quy)

BUK %>% ggplot(aes(x=TP1,y=TC))+
  geom_point(color="green")+
  labs(x="Chi tiêu cho thực phẩm",y="Tổng chi tiêu")+
  ggtitle("ĐỒ THỊ CHI TIÊU CHO THỰC PHẨM ẢNH HƯỞNG TỔNG CHI TIÊU")

• Đồ thị phân tán biểu diễn sự phụ thuộc của biến tổng chi tiêu vào biến chi tiêu cho thực phẩm (có đường hồi quy)

BUK %>% ggplot(aes(x=TP1,y=TC))+
  geom_point(color="green")+
  geom_smooth(formula = y~x,method="lm",color="red")+
  labs(x="Chi tiêu cho thực phẩm",y="Tổng chi tiêu")+
  ggtitle("ĐỒ THỊ CHI TIÊU CHO THỰC PHẨM ẢNH HƯỞNG TỔNG CHI TIÊU")

Nhận xét: nhìn vào đồ thị trên thì ta thấy được mức tương quan dương giữa hai biến, khi mức chi tiêu thực phẩm tăng lên thì tổng chi tiêu hộ gia đình cũng tăng theo vì độ dốc đường hồi quy theo chiều dương. - Đồ thị chi tiêu cho thực phẩm ở cách nhóm tuổi ảnh hưởng lên tổng chi tiêu

BUK %>% ggplot(aes(x=TP1,y=TC,color=Tcoded))+
  geom_point()+
  geom_smooth(aes(color=Tcoded),formula = y~x, method="lm")+
  labs(x="Chi tiêu cho thực phẩm",y="Tổng chi tiêu")+
  ggtitle("ĐỒ THỊ CHI TIÊU DÀNH CHO THỰC PHẨM") 

Nhận xét: Khi có cùng một mức chi tiêu cho thực phẩm thì tổng chi tiêu của các hộ gia đình thuộc nhóm trung niên có mức tổng chi tiêu cao hơn ví dụ cùng mức chi tiêu cho thực phẩm là 50 thì ở nhóm trung niên sẽ có mức tổng chi tiêu cao hơn. Bên dưới cũng là đồ thị phản ánh sự phụ thuộc tổng chi tiêu dành cho thực phẩm nhưng phân ra từng nhóm tuổi riêng biệt.

BUK %>% ggplot(aes(x=TP1,y=TC))+
  geom_point(aes(color=Tcoded))+
  geom_smooth(aes(color=Tcoded),formula = y~x,method="lm")+
  labs(x="Chi tiêu cho thực phẩm",y="Tổng chi tiêu")+
  ggtitle("ĐỒ THỊ CHI TIÊU DÀNH CHO THỰC PHẨM")+
  facet_grid(.~Tcoded)

BUK %>% ggplot(aes(x=TP,y=TC, color=Tcoded))+
  geom_point()+
  geom_smooth(aes(color=Tcoded),formula = y~x,method="lm")+
  labs(title="ĐỒ THỊ",y="Tổng chi tiêu",x="Chi tiêu cho thực phẩm %")

Nhận xét: Đây là đồ thị thể hiện sự phụ thuộc % tăng lên về chi tiêu thực phẩm thì tổng chi tiêu thay đổi như thế nào. Nhìn vào đồ thị ta thấy các đường hồi quy tuyến tính có độ dốc xuống có nghĩa là hai biến này có quan hệ tỷ lệ nghịch với nhau ở các nhóm tuổi. Ta có thể thấy, khi % chi tiêu dành cho thực phẩm tăng dần thì tổng chi tiêu sẽ giảm xuống. Đây cũng chưa phải là cơ sở để kết luận được mức tương quan giữa hai biến này, chi tiêu cho thực phẩm không có thể hoàn toàn giải thích được biến tổng chi tiêu vì tổng chi tiêu còn phụ thuộc vào các yếu tố như chi tiêu cho nhiên liệu, cho quần áo,… hay nó còn phụ thuộc vào thu nhập như phía trên ta phân tích

3.5.2 Đồ thị scatter plot đa biến

Đoạn mã sau sẽ tạo ra một biểu đồ ma trận tương quan với đồ thị phân tán (scatterplots) trong tam giác trên và đồ thị histogram trên đường chéo chính. Đối số histogram = TRUE đảm bảo rằng đồ thị histogram được bao gồm trong biểu đồ. Đối số pch = 19 thiết lập ký hiệu được sử dụng để vẽ các điểm trong đồ thị phân tán.

library("PerformanceAnalytics")
mydata <- BUK[,c("TP1","NL1","QA1","R1","PT1","K1","TT","TC")]
chart.Correlation(mydata, histogram=TRUE, pch=19)

Nhìn vào đồ thị trên thì ta có thể nhận xét được hệ số tương quan của từng cặp biến với nhau ví dụ hệ số tương quan giữa biến TP1 và TC là 0.61 cho thấy mức độ tương quan tương đối giữa hai biến này và hai biến này cũng có mối quan hệ tuyên tính khi đường hồi quy trong đồ thị là đường thẳng dốc. Tóm lại, nhìn vào đồ thị trên ta có thể nhìn xem giữa các biến có mối quan hệ tuyến tính hay không. mức độ tương quan.

3.5.3 Biểu đồ ma trận tương quan

Ma trận tương quan cho các biến cụ thể (TP1, NL1, QA1, R1, PT1, K1, TC, TT, T, TE) trong khung dữ liệu BUK. Hàm cor() tính toán ma trận tương quan cho các biến đã chọn trong dữ liệu BUK. Hàm as.table() chuyển đổi ma trận tương quan thành định dạng bảng. Hàm as.data.frame() chuyển đổi bảng thành dữ liệu. Hàm colnames() đặt tên cột của khung dữ liệu là “Var1”, “Var2” và “Correlation”. Hàm geom_tile() thêm các ô vào đồ thị, biểu thị sự tương quan giữa các biến. Hàm geom_text() thêm nhãn văn bản vào các ô, hiển thị giá trị tương quan đã làm tròn. Hàm scale_fill_gradient2() đặt gradient màu cho các ô, từ màu xanh (tương quan thấp) đến màu đỏ (tương quan cao), với màu trung điểm là màu trắng. Hàm theme_minimal() đặt kiểu đồ thị với giao diện tối giản

cor_matrix <- cor(BUK[, c("TP1","NL1","QA1","R1","PT1","K1","TC","TT","T","TE")])
cor_data <- as.data.frame(as.table(cor_matrix))
colnames(cor_data) <- c("Var1", "Var2", "Correlation")
ggplot(data = cor_data, aes(x = Var1, y = Var2)) +
  geom_tile(aes(fill = Correlation)) +
  geom_text(aes(label = round(Correlation, 2)), color = "black", size = 3) +
  scale_fill_gradient2(low = "blue", mid = "white", high = "red", midpoint = 0) +
  theme_minimal()

Dựa vào ma trận tương quan của các biến, ta có thể đọc và kết luận được mức độ tương quan mạnh yếu giữa các biến khác nhau: Hệ số ma trận tương quan của biến tổng chi tiêu (TC) và biến thực phẩm (TP1) là 0.61 con số này cho thấy giá trị này là dương và có giá trị tương đối cao, điều này cho thấy rằng mức chi tiêu cho thực phẩm có xu hướng tăng cùng với mức tổng chi tiêu của hộ gia đình. Hệ số ma trận tương quan của biến tổng chi tiêu (TC) và biến mức chi ngân sách cho nhiên liệu(NL1) là 0.3 giá trị này là dương và có giá trị tương đối trung bình, điều này cho thấy rằng mức chi tiêu cho nhiên liệu có xu hướng tăng cùng với mức tổng chi tiêu của hộ gia đình, tuy nhiên mức độ tương quan không mạnH. Tương tự ta có thể đọc được kết quả của từng cặp biến khác để phù hợp kết quả nghiên cứu.

Ngoài ra, dưới đây cũng là một cách vẽ biểu đồ ma trận tương quan bằng cách sử dụng gói corrplot

library(corrplot)
cor_matrix <-cor(BUK[, c("TP1","NL1","QA1","R1","PT1","K1","TC","TT","T","TE")])
corrplot(cor_matrix, type = "upper", order = "hclust", tl.col = "black", tl.srt = 45)

3.5.4 Biểu đồ cột

• Biểu đồ đếm số lượng hộ gia đình thuộc các nhóm tuổi có trong bộ data.

table(BUK$Tcoded)

## 
##   trẻ tuổi trung niên   cao tuổi 
##        400       1046         73

BUK %>% ggplot(aes(Tcoded))+
  geom_bar(fill="skyblue")+
  xlab("Nhóm tuổi")+
  ylab("Số hộ gia đình")

Trong đoạn mã trên, chúng ta sử dụng dữ liệu từ dataframe BUK và tạo biểu đồ cột bằng cách sử dụng ggplot(). Biến Tcoded được sử dụng trong aes() để xác định trục x của biểu đồ cột. Hàm geom_bar() được sử dụng để tạo các cột trong biểu đồ. Chúng ta đặt màu cho các cột bằng fill = “skyblue”. xlab() và ylab() được sử dụng để đặt nhãn cho trục x và trục y tương ứng. Đoạn mã trên sẽ tạo ra biểu đồ cột với trục x là “Nhóm tuổi” và trục y là “Số hộ gia đình”. Màu sắc của cột được đặt là “skyblue”. Nhìn vào đồ thị thì ta có thể nhận thấy nhóm tuổi trung niên chiếm số đông nằm trong khoảng hơn 1000 hộ gia đình, tiếp theo là nhóm tuổi trẻ tuổi và ít nhất là nhóm cao tuổi. Để tính cụ thể thì ta sẽ dùng lệnh table ta có thể tính chính xác được trong bộ data có 1046 hộ gia đình có chủ hộ thuộc nhóm tuổi trung niên, có 400 chủ hộ thuộc nhóm trẻ tuổi và nhóm cao tuổi chỉ có 73 người.

• Biểu đồ cột vẽ theo tỷ lệ %.

BUK %>% group_by(Tcoded) %>% summarise(n=n()) %>% 
  mutate(pg = percent(n/sum(n)), accuracy=.01) %>% 
  ggplot(aes(x=Tcoded,y=pg))+
  geom_col(fill="purple")+
  theme_classic()+
  labs(x="Nhóm tuổi",y="Tỷ lệ %")

Trong đoạn mã trên, chúng ta sử dụng dữ liệu từ data frame BUK, sử dụng group_by() để nhóm dữ liệu theo biến Tcoded. Sử dụng summarise() để tính số lượng (n) cho mỗi nhóm Tcoded. Sử dụng mutate() để tính tỷ lệ phần trăm (pg) bằng cách chia n cho tổng n và định dạng với độ chính xác 0.01 bằng scales::percent(). Sử dụng ggplot() để tạo biểu đồ với aes() xác định trục x là Tcoded và trục y là pg. Sử dụng geom_col() để tạo cột trong biểu đồ với màu sắc đặt là “purple”. Sử dụng theme_classic() để thiết lập giao diện biểu đồ với phong cách cổ điển. Sử dụng labs() để đặt nhãn cho trục x và trục y tương ứng. Đoạn mã trên sẽ tạo ra biểu đồ cột với trục x là “Nhóm tuổi” và trục y là “Tỷ lệ %”. Các cột sẽ được tô màu “purple”. Kết quả đọc được từ đồ thị là có 26% số hộ gia đình có chủ hộ thuộc nhóm trẻ tuổi, 69% chủ hộ gia đình thuộc nhóm tuổi trung niên và 5% còn lại là số hộ gia đình có chủ hộ thuộc nhóm cao tuổi.

• Biểu đồ cột thể hiện tỷ lệ % và số hộ gia đình.

BUK %>% 
  ggplot(aes(Tcoded)) +
  geom_bar(fill = "purple") +
  geom_text(aes(label = scales::percent(after_stat(count / sum(count)))), stat = "count", color = "red",vjust = -0.5) +
  theme_classic() +
  labs(x = "Nhóm tuổi", y = "Số hộ gia đình")

Sử dụng geom_text() để thêm ghi chú vào từng cột. Aesthetic label được đặt là tỷ lệ phần trăm (scales::percent(after_stat(count / sum(count)))). Statistic count được sử dụng để tính số lượng mỗi nhóm Tcoded. Màu chữ được đặt là “red”. Tham số vjust được đặt là -0.5 để điều chỉnh vị trí dọc của ghi chú.

• Biểu đồ cột ngang.

BUK %>% count(Tcoded) %>% 
  mutate(pc=percent(n/sum(n)),accuracy=0.01) %>% 
  ggplot(aes(x=Tcoded,y=n))+
  geom_col(fill="pink")+
  geom_text(aes(label=pc), color="black",hjust=1.25,size=5)+
  labs(x = "Nhóm tuổi", y = "Số hộ gia đình")+
  coord_flip()

• Biểu đồ đếm số lượng hộ gia đình thuộc các nhóm tuổi có trong bộ data dựa trên số con trong một gia đình.

BUK %>%  ggplot(aes(x = Tcoded, y = after_stat(count))) +
  geom_bar(fill = 'blue') +
  geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'red', vjust = - .5) +
  facet_grid(. ~ TE) +
  labs(x = 'Nhóm tuổi', y = 'Số hộ gia đình')

Biểu đồ trên thể hiện trục hoành là tuổi chủ hộ gia đình, trục tung là số lượng hộ gia đình và được tính % trên mỗi cột, và được tạo trên biến số con trong gia đình TE. Kết quả ta đọc được là:

• Ở nhóm hộ gia đình có 1 con, thì số chủ hộ thuộc nhóm tuổi trẻ tuổi là hơn 200 và chiếm 14.2%, số chủ hộ gia đình thuộc nhóm trung niên là hơn 300 và chiếm 21.7%, số chủ hộ thuộc nhóm cao tuổi là ít nhất ít hơn 100 và chỉ chiếm 3.2%

• Ở nhóm hộ gia đình có 2 con, thì số chủ hộ thuộc nhóm tuổi trẻ tuổi là ít hơn 200 và chiếm 12.2%, số chủ hộ gia đình thuộc nhóm trung niên là hơn 700 và chiếm 47.1%, số chủ hộ thuộc nhóm cao tuổi là rất ít nhất chỉ chiếm 1.6%.

• Biểu đồ cột đôi

df <- BUK %>% count(Tcoded,TE) %>% mutate(pc=prop.table(n))

ggplot(df, aes(x = Tcoded, y = n, fill = factor(TE))) +
  geom_col(position = "dodge") +
  geom_text(aes(label=percent(pc, accuracy = .01)), position = position_dodge(1), vjust = -.5, size = 3)+
  labs(title = "Biểu đồ cột đôi",
       x = "Nhóm tuổi",
       y = "Số lượng",
       fill = "TE") +
  theme_minimal()

Một dạng khác của biểu đồ cột thì biểu đồ cột đôi cho ta so sánh được ở cùng một nhóm tuổi có sự khác nhau về số lượng hộ gia đình có 1 con và 2 con là như thế nào. Ở nhóm trẻ tuổi thì số lượng hộ gia đình có hai con ít hơn và ít hơn xấp xỉ 2%, ở nhóm tuổi trung niên thì số lượng hộ gia đình có hai con nhiều hơn và nhiều hơn 25.42%, ở nhóm cao tuổi thì số lượng hộ gia đình có 1 con cao hơn và cao hơn gần gấp 2 lần số hộ gia đình có 2 con.

• Biểu đồ cột chồng.

ggplot(df, aes(x = Tcoded, y = n, fill = factor(TE))) +
  geom_col() +
  geom_text(aes(label = percent(pc, accuracy = .01)), position = position_stack(vjust = 0.5), size = 2) +
  ylab('Số Người') +
  xlab('Số Con')

• Biểu đồ cột(Số con trong gia đình)

BUK %>% ggplot(aes(TE))+
  geom_bar(fill="blue")+
  labs(x="Số con trong hộ gia đình",y="Số hộ gia đình")

BUK %>%  ggplot(aes(x = TE, y = after_stat(count))) +
  geom_bar(fill = 'blue') +
  geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'red', vjust = - .5) +
  facet_grid(. ~ Tcoded) +
  labs(x = 'Nhóm tuổi', y = 'Số hộ gia đình')

3.5.5 Biểu đồ tròn (Pie chart)

Biều đồ tròn với ggplot2

• Biểu đồ phân bố nhóm tuổi.

BUK_summary <- BUK %>%
  group_by(Tcoded) %>%
  summarise(n = n()) %>%
  mutate(percentage = n/sum(n))
ggplot(BUK_summary, aes(x = "", y = percentage, fill = Tcoded)) +
  geom_bar(stat = "identity", width = 1) +
  geom_text(aes(label = paste0(round(percentage*100), "%")), position = position_stack(vjust = 0.5))+
  coord_polar("y", start = 0) +
  scale_fill_manual(values = c("skyblue", "purple", "pink"), name = "Nhóm tuổi") +
  labs(title = "BIỂU ĐỒ PHÂN BỐ NHÓM TUỔI") +
  theme_minimal() +
  theme(legend.position = "bottom")

Giải thích: Em tính tỷ lệ phần trăm của mỗi nhóm Tcoded bằng cách sử dụng group_by, summarise, và mutate từ gói dplyr. ggplot() để tạo một đối tượng biểu đồ với aes(). geom_bar(stat = “identity”, width = 1) để vẽ các thanh trong biểu đồ tròn. Tham số stat = “identity” cho phép sử dụng giá trị y đã được tính toán. Tham số width = 1 xác định chiều rộng của các thanh. coord_polar(“y”, start = 0) để chuyển sang hệ tọa độ polar và đặt góc bắt đầu là 0. scale_fill_manual() để tùy chỉnh màu sắc cho các nhóm Tcoded. labs() để đặt tiêu đề cho biểu đồ. theme_minimal() để chọn giao diện biểu đồ là minimal. theme(legend.position = “bottom”) để di chuyển chú thích xuống dưới biểu đồ.

• Biểu đồ phân bố số con trong hộ gia đình

BUK1 <- BUK %>% group_by(TE) %>% summarise(n=n()) %>% 
  mutate(pc=n/sum(n))
ggplot(BUK1, aes(x="",y=pc,fill=factor(TE)))+
  geom_bar(stat = "identity", width = 1) +
  geom_text(aes(label = paste0(round(pc*100), "%")), position = position_stack(vjust = 0.5))+
  coord_polar("y", start = 0) +
  scale_fill_manual(values = c("skyblue", "pink"), name = "Nhóm tuổi") +
  labs(title = "BIỂU ĐỒ PHÂN BỐ SỐ CON TRONG HỘ GIA ĐÌNH") +
  theme_minimal()

Có 39% số hộ gia đình có con là 1 và có 61% hộ gia đình có số con là 2.

Biểu đồ tròn với gói có sẵn trong R

pie(table(BUK$Tcoded), col = c("green","pink", "blue"))
legend("topright", legend = levels(BUK$Tcoded), fill = c("green", "pink", "blue"), title = "Nhóm tuổi")

df <- BUK %>% count(Tcoded) %>% mutate(pc=prop.table(n))
pie(table(BUK$Tcoded),labels=percent(df$pc), col = c("green","pink", "blue"))
legend("topright", legend = levels(BUK$Tcoded), fill = c("green", "pink", "blue"), title = "Nhóm tuổi")

Số chủ hộ gia đình thuộc nhóm trẻ tuổi chiếm 26%, số chủ hộ gia đình có tuổi thuộc nhóm trung niên chiếm 69%, số chủ hộ gia đình có tuổi thuộc nhóm 5%.

3.5.6 Biểu đồ hộp (Boxplots)

data <- BUK[,c("TP1")]
boxplot(data)

• Vẽ boxplot cho chi tiêu thực phẩm(TP1) theo cả ba nhóm tuổi là nhóm trẻ tuổi, trung niên và cao tuổi.

ggplot(BUK, aes(Tcoded, TP1, colour = Tcoded)) + geom_boxplot(show.legend = F)

Biểu đồ hộp cho ta biết được tứ phân vị, các điểm ngoại lai, dự đoán được xem có phân phối chuẩn hay không. Nghĩa là chúng ta sẽ có 50% số quan sát nằm trong khoảng từ phân vị thứ nhất Q1 đến phân vị thứ ba Q3 . Còn Q2 chính là trung vị (median). Nếu Q2 – Q1 > Q3 – Q2 thì phân phối sẽ méo về phía dương (positive skewness) và ngược lại. Nếu Q2 nằm chính giữa thì chúng ta có phân phối chuẩn.ví dụ trên ta có thể đọc được mức chi tiêu trung bình dành cho thực phẩm ở nhóm cao tuổi là cao nhất, ở nhóm trẻ tuổi là thấp nhất. Ở nhóm cao tuổi sẽ có phân phối méo về phía dương. Và nhóm trẻ tuổi gần như là có phân phối chuẩn.

4 TUẦN 3

Package: gapminder - Datasets: gapminder (Excerpt of the Gapminder data on life expectancy, GDP per capita, and population by country)

Mô tả dữ liệu: Dữ liệu Gapminder là tập dữ liệu về tuổi thọ, GDP bình quân đầu người và dân số theo quốc gia.

Số quan sát: 1794

Chứa 6 biến:

1. country: Quốc gia, dạng factor với 142 quốc gia.

2. continent: Lục địa, dạng factor với 5 lục địa.

3. year: Năm, từ 1952 đến 2007 với khoảng cách là 5 năm.

4. lifeExp: Tuổi thọ trung bình, tính từ khi sinh, đơn vị là năm.

5. pop: Dân số.

6. gdpPercap: GDP bình quân đầu người, tính bằng đô la Mỹ đã điều chỉnh cho lạm phát.

4.1 Lệnh pivot_wider

Đầu tiên, em sẽ thực hiện thao tác gọi các package cần thiết như là tidyverse, gapminder chứa bộ dữ liệu. Tiếp đến thực hiện thao tác gán bộ datasets đó vào một biến mới có tên là gmd và cho hiện bộ dữ liệu này.

library(DT)
library(tidyverse)
library(gapminder)
data(gapminder)
gmd <- gapminder
datatable(gmd)

4.1.1 Lệnh pivot_wider tổng hợp tuổi thọ trung bình, dân số, GDP của các quốc gia ở các châu lục theo năm

Lệnh pivot_wider trên để chuyển đổi dữ liệu từ dạng dài sang dạng rộng dựa trên biến “year” và giá trị “lifeExp”, “pop”, “gdpPercap” trong bộ dữ liệu “gmd”. Với câu lệnh đầu tiên, tạo ra bảng dữ liệu “gmdex” với các cột là các năm (cột “year”) và giá trị là tuổi thọ trung bình (cột “lifeExp”). Câu lệnh thứ hai, tạo một bảng dữ liệu dạng rộng “gmdpop” với các cột mới là các năm và các giá trị là dân số của từng quốc gia. Câu lệnh thứ ba, tạo ra bảng dữ liệu về GDP theo từng năm của từng quốc gia tương ứng. Các bảng này có cấu trúc dạng rộng, với mỗi quốc gia (cột “country”) và châu lục (cột “continent”) chỉ xuất hiện một lần và được kết hợp với các giá trị tuổi thọ trung bình, dân số, GDP bình quân đầu người tương ứng của từng năm và lệnh arrange sắp xếp theo từng châu lục. Giúp em có thể dễ dàng xem tổng quan về tuổi thọ trung bình, dân số, GDP bình quân đầu người theo năm ở các quốc gia của từng châu lục trong bộ dữ liệu “gmd”, từ đó sẽ đưa ra phân tích từ các bộ dữ liệu chuyển đổi từ dạng dài sang dạng rộng này.

• Bảng tổng hợp dạng rộng tuổi thọ trung bình của các quốc gia theo năm:

gmdex<- gmd %>% select(country,continent,year,lifeExp) %>% 
  pivot_wider(names_from = year, values_from = lifeExp) %>% arrange(continent)
datatable(gmdex, options = list(scrollX = TRUE, pageLength = 5))

• Bảng tổng hợp dạng rộng của dân số từng quốc gia theo năm:

gmdpop <- gmd %>% select(country,continent,year,pop) %>% 
  pivot_wider(names_from = year, values_from = pop) %>% arrange(continent)
datatable(gmdpop, options = list(scrollX = TRUE, pageLength = 5))

• Bảng tổng hợp GDP theo đầu người của từng quốc gia theo năm:

gmdgdp <- gmd %>% select(country,continent,year,gdpPercap) %>%
  pivot_wider(names_from = year, values_from = gdpPercap) %>% arrange(continent)
datatable(gmdgdp, options = list(scrollX = TRUE, pageLength = 5))

4.1.2 Tính toán dựa trên bảng dữ liệu đã chuyển đổi từ lệnh pivot_wider

• Lập ra bảng các quốc gia ứng với châu lục có tuổi thọ trung bình cao nhất qua các năm:

variable_names <- names(gmdex)[-c(1, 2)]
max_values <- list()
max_countries <- list()
continents <- list()
for (ver in variable_names) {
  max_value <- max(gmdex[[ver]], na.rm = TRUE)
  max_values[[ver]] <- max_value
  max_country <- gmdex$country[which.max(gmdex[[ver]])]
  max_countries[[ver]] <- max_country
  continent <- gmdex$continent[which.max(gmdex[[ver]])]
  continents[[ver]] <- continent
}
result3 <- data.frame(Year = names(max_values),
                     lifeExp_max = unlist(max_values),
                     Country = unlist(max_countries),
                     Continent = unlist(continents))
result3

##      Year lifeExp_max Country Continent
## 1952 1952      72.670  Norway    Europe
## 1957 1957      73.470 Iceland    Europe
## 1962 1962      73.680 Iceland    Europe
## 1967 1967      74.160  Sweden    Europe
## 1972 1972      74.720  Sweden    Europe
## 1977 1977      76.110 Iceland    Europe
## 1982 1982      77.110   Japan      Asia
## 1987 1987      78.670   Japan      Asia
## 1992 1992      79.360   Japan      Asia
## 1997 1997      80.690   Japan      Asia
## 2002 2002      82.000   Japan      Asia
## 2007 2007      82.603   Japan      Asia

Các dòng lệnh trên sẽ hiện thị kết quả là giá trị lớn nhất của tuổi thọ trung bình trong từng năm với các quốc gia ở các châu lục tương ứng: Năm 1952, thì ở NaUy (Châu Âu) có tuổi thọ trung bình cao nhất 72.67 tuổi; Năm 1957, ở Iceland có tuổi thọ trung bình cao nhất 73.47 tuổi; tương tự ta cũng đọc được kết quả như là từ năm 1982-2007, Nhật Bản ở Châu á là quốc gia có tuổi thọ trung bình cao nhất và các con số này cũng cao hơn so với những năm trước đó. Ta cũng nhận thấy rằng tuổi thọ trung bình cao nhất ở các quốc gia có sự tăng dần qua các năm.

• Lập ra bảng các quốc gia ứng với châu lục có dân số cao nhất qua các năm:

for (ver in variable_names) {
  max_value <- max(gmdpop[[ver]], na.rm = TRUE)
  max_values[[ver]] <- max_value
  max_country <- gmdpop$country[which.max(gmdpop[[ver]])]
  max_countries[[ver]] <- max_country
  continent <- gmdpop$continent[which.max(gmdpop[[ver]])]
  continents[[ver]] <- continent
}
result4 <- data.frame(Year = names(max_values),
                     pop_max = unlist(max_values),
                     Country = unlist(max_countries),
                     Continent = unlist(continents))
result4

##      Year    pop_max Country Continent
## 1952 1952  556263527   China      Asia
## 1957 1957  637408000   China      Asia
## 1962 1962  665770000   China      Asia
## 1967 1967  754550000   China      Asia
## 1972 1972  862030000   China      Asia
## 1977 1977  943455000   China      Asia
## 1982 1982 1000281000   China      Asia
## 1987 1987 1084035000   China      Asia
## 1992 1992 1164970000   China      Asia
## 1997 1997 1230075000   China      Asia
## 2002 2002 1280400000   China      Asia
## 2007 2007 1318683096   China      Asia

Các dòng lệnh trên sẽ trả về kết quả là các quốc gia ứng với châu lục của nó có dân số đông nhất qua các năm.Nhìn vào bảng trên ta nhận thấy được từ năm 1952-2007, Trung Quốc một quốc gia ở châu á có dân số luôn cao nhất ở các năm trong bộ dữ liệu “gmd”. Và số người ở quốc gia này tăng cao qua các năm, tính năm 2007 thì số dân quốc gia này là 1318683096 người.

• Lập ra bảng các quốc gia ứng với châu lục có GDP bình quân đầu người cao nhất qua các năm:

for (ver in variable_names) {
  max_value <- max(gmdgdp[[ver]], na.rm = TRUE)
  max_values[[ver]] <- max_value
  max_country <- gmdgdp$country[which.max(gmdgdp[[ver]])]
  max_countries[[ver]] <- max_country
  continent <- gmdgdp$continent[which.max(gmdgdp[[ver]])]
  continents[[ver]] <- continent
}
result5 <- data.frame(Year = names(max_values),
                     gdp_max = unlist(max_values),
                     Country = unlist(max_countries),
                     Continent = unlist(continents))
result5

##      Year   gdp_max      Country Continent
## 1952 1952 108382.35       Kuwait      Asia
## 1957 1957 113523.13       Kuwait      Asia
## 1962 1962  95458.11       Kuwait      Asia
## 1967 1967  80894.88       Kuwait      Asia
## 1972 1972 109347.87       Kuwait      Asia
## 1977 1977  59265.48       Kuwait      Asia
## 1982 1982  33693.18 Saudi Arabia      Asia
## 1987 1987  31540.97       Norway    Europe
## 1992 1992  34932.92       Kuwait      Asia
## 1997 1997  41283.16       Norway    Europe
## 2002 2002  44683.98       Norway    Europe
## 2007 2007  49357.19       Norway    Europe

Các dòng lệnh trên trả về kết quả các quốc gia ứng với các châu lục có GDP bình quân đầu người cao nhất ở từng năm trải dài từ năm 1952-2007 (khoảng cách 5 năm). GDP Per capita dùng để đo mức độ phát triển kinh tế của một quốc gia và thể hiện mức độ giàu có trung bình của người dân trong quốc gia đó. Nhìn vào bảng trên thì ta thây được rằng: Kuwait là quốc gia ở châu á có GDP bình quân đầu người cao nhất ở 6 năm liền từ 1952-1977 (khoảng cách 5 năm) và đất nước này tiếp tục dẫn đầu về quốc gia có GDP cao nhất ở năm 1992. Các con số ở Kuwait cao hơn rất nhiều so với các quốc gia đứng đầu ở các năm 1982 như là Saudi Arabia hay là ở Norway(NaUy). được sử chỉ số gdpPercapita dùng để đo mức độ phát triển kinh tế của một quốc gia và thể hiện mức độ giàu có trung bình của người dân trong quốc gia đó.

4.2 Lệnh pivot_longer

4.2.1 Chuyển đổi từ bảng dạng rộng sang dạng dài

Ở phần trước em đã thực hiện chuyển đổi bộ dữ liệu ban đầu thành dạng rộng. ở phần này em sẽ thực hiện chuyển đổi từ dạng rộng sang dạng dài:

• Chuyển dữ liệu dạng rộng gmdex (tuổi thọ trung bình theo năm) sang dạng dài

gmdexl <- gmdex %>% pivot_longer(cols= names(gmdex)[-c(1, 2)], names_to = "year",values_to = "lifeExp")
datatable(gmdexl)

Giải thích: cols= names(gmdex)[-c(1, 2)] lệnh này để chọn các cột năm mà ta cần chuyển sang dữ liệu từ rộng sang dài. Việc chuyển đổi dữ liệu từ rộng sang dài để chúng ta đễ dàng trực quan hóa dữ liệu sau đó đưa ra nhiều so sánh phân tích trên bảng dữ liệu đã chuyển đổi.

• Chuyển đổi dữ liệu dạng rộng gmdpop (Dân số) sang dạng dài

gmdpopl <- gmdpop %>% pivot_longer(cols= names(gmdpop)[-c(1, 2)], names_to = "year",values_to = "pop")
datatable(gmdpopl)

• Chuyển đổi dữ liệu dạng rộng gmdgdp (gdpPercapita) sang dạng dài

gmdgdpl <- gmdgdp %>% pivot_longer(cols= names(gmdgdp)[-c(1, 2)], names_to = "year",values_to = "GDP")
datatable(gmdgdpl)

• Ta cũng có thể ghép dữ liệu chuyển đổi từ rộng sang dài theo cột để đưa được về bộ dữ liệu gốc ban đầu bằng lệnh bind_cols, select() và sắp xếp nó theo quốc gia bằng lệnh arrange().

gmd1 <-  bind_cols(select(gmdexl, everything()), select(gmdpopl,-year, -country,-continent),select(gmdgdpl, -year,-country,-continent)) %>% arrange(country)
datatable(gmd1)

4.2.2 Vẽ đồ thị đường biểu diễn tuổi thọ trung bình các quốc gia theo năm; dân số theo năm; GDP bình quân đầu người theo năm từ các bảng dữ liệu dạng dài vừa chuyển.

• Đồ thị đường biểu diễn tuổi thọ trung bình các quốc gia qua các năm:

gmdex_filtered <- gmdexl %>% 
  filter(country %in% c("Angola","Algeria","Vietnam","China","United States","United Kingdom"))

ggplot(gmdex_filtered, aes(x = year, y = lifeExp, color = country, group = country)) +
  geom_line() +
  labs(x = "Year", y = "Life Expectancy") +
  theme_minimal()

Nhận xét: Trong các quốc gia Angola, Algeria, Vietnam, China, United States, United Kingdom.Thì United States, United Kingdom có tuổi thọ trung bình cao và tăng nhẹ qua các năm giai đoạn 1952-2007 khoảng cách 5 năm, Angola là quốc gia có tuổi thọ trung bình thấp trong số các quốc gia này. ở China thì giai đoạn biến động mạnh nhất là từ năm 1952-1962 có sự tăng và sụt giảm của tuổi thọ trung bình và tăng mạnh từ năm 1962 về sau, còn ở Việt Nam thì và algeria có độ tuổi thọ trung bình tăng đều qua các năm. Ngoài ra khi nhìn vào đồ thị trên ta có thể đưa ra dự báo cho xu hướng trong tương lai.

• Đồ thị đường biểu diễn dân số các quốc gia qua các năm:

gmdpop_filtered <- gmdpopl %>% 
  filter(country %in% c("Angola","Algeria","Vietnam","China","United States","United Kingdom"))

ggplot(gmdpop_filtered, aes(x = year, y = pop, color = country, group = country)) +
  geom_line() +
  labs(x = "Year", y = "Population") +
  theme_minimal()

Nhận xét: ở đồ thị cho biết về dân số các quốc gia qua các năm từ 1952-2007, thì các quốc gia như là Việt Nam, UK, Angola hay là Algeria không có sự tăng trưởng quá mạnh về mặt dân số. Ở US, có sự tăng trưởng về dân số và dân số ở US cao hơn so với các nước đang so sánh ở cùng thời điểm. Tuy nhiên, ở Trung Quốc có một sự bùng nổ và tăng trưởng dân số nhanh ở giai đoạn này bằng chứng cho thấy dân số ở Trung Quốc luôn đứng đầu ở các năm.

• Đồ thị đường biểu diễn GDP bình quân đầu người các quốc gia qua các năm:

gmdgdp_filtered <- gmdgdpl %>% 
  filter(country %in% c("Angola","Algeria","Vietnam","China","United States","United Kingdom"))

ggplot(gmdgdp_filtered, aes(x = year, y = GDP , color = country, group = country)) +
  geom_line() +
  labs(x = "Year", y = "GDP per capita") +
  theme_minimal()

Nhận xét: ở US thì có sự tăng trưởng GDP cao nhất trong các nước mà em đang xét trên đồ thị, GDP ở US cao cho thấy mức thu nhập người dân ổn định và điều kiện sống của người dân cũng cao hơn các nước còn lại còn ở China số dân trong quốc gia đông nhưng mức GDP trên thu nhập đầu người thấp hơn UK điều này cho thấy ở giai đoạn này nền kinh tế China chưa phát triển bằng US. Ở các nước còn lại, thì GDP tăng trưởng thấp, ở Việt Nam ta có thể thấy mức GDP không cao có sự phát triển nhưng chậm và không nhiều.

4.2.3 Hệ số tương quan và đồ thị Scatter plot theo năm cụ thể.

• Hệ số tương quan hai biến ở năm 2007:

data_year <- subset(gmd, year == 2007)
correlation <- cor(data_year$gdpPercap, data_year$lifeExp)
correlation

## [1] 0.6786624

Hệ số tương quan hai biến gdpPercap ~ lifeExp là 0.6786624, cho thấy mức độ tương quan tương đối giữa hai biến GDP bình quân đầu người và tuổi thọ trung bình, khi mà GDP bình quân đầu người tăng thì tuổi thọ trung bình tăng theo. Tuy nhiên, cũng không thể hoàn toàn nói tuổi thọ tăng là do GDP đầu người mà cần tìm hiểu thêm nhiều yếu tố khác.

• Ngoài ra, ta còn có thể lập ma trận hệ số tương quan ở năm 2007 giữa các biến:

data_year <- data_year %>% select(lifeExp, pop, gdpPercap)
correlation <- cor(data_year)
correlation

##              lifeExp         pop  gdpPercap
## lifeExp   1.00000000  0.04755312  0.6786624
## pop       0.04755312  1.00000000 -0.0556756
## gdpPercap 0.67866240 -0.05567560  1.0000000

Hệ số tương quan hai biến lifeExp và pop là 0.04755312 cho thấy có mối quan hệ tương quan rất yếu giữa hai biến này. Hệ số tương quan hai biến gdpPercap và pop là -0.05567560 cho thấy sự tương quan âm và mối tương quan rất yếu giữa hai biến.

• Đồ thị scatter plot giữa hai biến gdpPercap ~ lifeExp

ggplot(data_year, aes(x = gdpPercap, y = lifeExp)) +
  geom_point() +
  geom_smooth(formula = y ~ x, method = "lm", se = FALSE) +
  xlab("GDP per capita") +
  ylab("Life Expectancy") +
  ggtitle("Bieu do gdpPercap và lifeExp (Year: 2007)")

4.2.4 Phân tích trên một quốc gia (VIỆT NAM)

• Lập ma trận tương quan đa biến.

Lọc ra quốc gia Việt Nam, country %in% c(“Vietnam”), nghĩa là chỉ lấy các dòng có giá trị trong cột “country” trùng khớp với giá trị “Vietnam”.

gmdVN <- gmd %>% filter(country %in% c("Vietnam"))
datatable(gmdVN)

Hoặc lọc theo câu lệnh filter(country == “Vietnam”) và chọn các cột biến mà ta cần lọc. Sau đó lập ma trận tương quan giữa các biến:

vietnam_data <- gmd %>% filter(country == "Vietnam") %>% select(lifeExp, pop, gdpPercap)
cor_matrix <- cor(vietnam_data)
cor_matrix

##             lifeExp       pop gdpPercap
## lifeExp   1.0000000 0.9978700 0.7905777
## pop       0.9978700 1.0000000 0.8146236
## gdpPercap 0.7905777 0.8146236 1.0000000

cor_data <- as.data.frame(as.table(cor_matrix))
colnames(cor_data) <- c("Var1", "Var2", "Correlation")
ggplot(data = cor_data, aes(x = Var1, y = Var2)) +
  geom_tile(aes(fill = Correlation)) +
  geom_text(aes(label = round(Correlation, 2)), color = "black", size = 3) +
  scale_fill_gradient2(low = "blue", mid = "white", high = "red", midpoint = 0) +
  theme_minimal()

Ma trận tương quan đa biến cho thấy các hệ số tương quan giữa tuổi thọ, dân số và GDP của Việt Nam như sau: Tuổi thọ (lifeExp) có một mức độ tương quan cao với cả dân số (pop) và GDP per capita (gdpPercap). Hệ số tương quan giữa tuổi thọ và dân số là 0.9978700, trong khi hệ số tương quan giữa tuổi thọ và GDP per capita là 0.7905777. Dân số (pop) cũng có một mức độ tương quan cao với cả tuổi thọ và GDP per capita. Hệ số tương quan giữa dân số và tuổi thọ là 0.9978700, trong khi hệ số tương quan giữa dân số và GDP per capita là 0.8146236. GDP per capita (gdpPercap) có mức độ tương quan cao với tuổi thọ và dân số. Hệ số tương quan giữa GDP per capita và tuổi thọ là 0.7905777, trong khi hệ số tương quan giữa GDP per capita và dân số là 0.8146236. Các kết quả này cho thấy rằng tuổi thọ, dân số và GDP per capita của Việt Nam có mức độ tương quan mạnh với nhau. Tuổi thọ và dân số có mối quan hệ gần như tương đồng nhau, trong khi GDP per capita có mối quan hệ tương đối với cả tuổi thọ và dân số.

• Phân tích hồi quy hai biến lifeExp ~ gdpPercap

model <- lm(lifeExp ~ gdpPercap, data = vietnam_data)
summary(model)

## 
## Call:
## lm(formula = lifeExp ~ gdpPercap, data = vietnam_data)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -10.0700  -7.5196   0.5225   6.6883  10.6690 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 40.221470   4.791908   8.394 7.71e-06 ***
## gdpPercap    0.016958   0.004154   4.083  0.00221 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 7.818 on 10 degrees of freedom
## Multiple R-squared:  0.625,  Adjusted R-squared:  0.5875 
## F-statistic: 16.67 on 1 and 10 DF,  p-value: 0.002205

Kết quả của mô hình hồi quy hai biến giữa lifeExp và gdpPercap của dữ liệu Việt Nam như sau:

Mô hình hồi quy tuyến tính: lifeExp = 40.221470 + 0.016958 * gdpPercap. Hệ số chặn: 40.221470; Hệ số hồi quy: 0.016958 cho biết khi gdpPercap tăng 1 đơn vị thì lifeExp tăng 0.016958 đơn vị. Giá trị p-value cho hệ số gdpPercap là 0.00221, có nghĩa là có sự khác biệt đáng kể trong lifeExp giữa các mức độ của gdpPercap. Multiple R-squared là 0.625, nghĩa là mô hình giải thích được 62.5% sự biến thiên trong lifeExp bằng biến độc lập đã được sử dụng. Adjusted R-squared là 0.5875, một chỉ số điều chỉnh của R-squared, giúp đánh giá mức độ phù hợp của mô hình hồi quy. F-statistic (F-test): 16.67, giá trị p-value liên quan đến F-statistic là 0.002205, cho thấy mô hình hồi quy có ý nghĩa thống kê. Tóm lại, kết quả cho thấy có một mối quan hệ dương giữa gdpPercap và lifeExp ở Việt Nam. Mô hình hồi quy tuyến tính giải thích được một phần đáng kể sự biến đổi trong tuổi thọ trung bình (lifeExp) dựa trên GDP per capita (gdpPercap).

• Vẽ biểu đồ biểu diễn hai biến.

ggplot(vietnam_data, aes(x = gdpPercap, y = lifeExp)) +
  geom_line() +
  labs(x = "GDP percapita", y = "Life Expectancy") +
  theme_minimal()

4.2.5 So sánh tương quan giữa Việt Nam và Hoa Kỳ

 vietmy <- gmd %>% filter(country %in% c("Vietnam","United States"))

gmdUS <- gmd %>% filter(country %in% c("United States"))
cor <- cor(gmdVN$gdpPercap,gmdUS$gdpPercap)
cor

## [1] 0.86657

Kết quả tính toán tương quan giữa GDP per capita của Việt Nam (gmdVN) và GDP per capita của Hoa Kỳ (gmdUS) là 0.86657. Giá trị này thể hiện một mức tương quan dương rất mạnh giữa hai biến, cho thấy mối quan hệ tích cực và tương đối chặt chẽ giữa mức độ phát triển kinh tế của cả hai quốc gia. Tức là khi GDP per capita của một quốc gia tăng, thì GDP per capita của quốc gia kia cũng tăng theo.

model <- lm(gmdUS$gdpPercap ~ gmdVN$gdpPercap )
summary(model)

## 
## Call:
## lm(formula = gmdUS$gdpPercap ~ gmdVN$gdpPercap)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
##  -6451  -4832   1018   3523   6538 
## 
## Coefficients:
##                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     11194.146   3110.470   3.599 0.004857 ** 
## gmdVN$gdpPercap    14.805      2.696   5.491 0.000265 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 5075 on 10 degrees of freedom
## Multiple R-squared:  0.7509, Adjusted R-squared:  0.726 
## F-statistic: 30.15 on 1 and 10 DF,  p-value: 0.0002651

Mô hình hồi quy: US = 11194.146 + 14.805 VN

Đánh giá mô hình:

Giá trị p-value của hệ số gmdVN$gdpPercap là 0.000265, nhỏ hơn mức ý nghĩa 0.05, cho thấy mối liên hệ giữa GDP per capita của Việt Nam và Hoa Kỳ là có ý nghĩa thống kê. Giá trị Multiple R-squared là 0.7509, có nghĩa là 75.09% sự biến thiên của GDP per capita của Hoa Kỳ có thể được giải thích bởi sự biến thiên của GDP per capita của Việt Nam. Mô hình có điểm điều chỉnh R-squared là 0.726, cho thấy mô hình có độ chính xác vừa phải. Kết luận: Dựa trên kết quả phân tích, mô hình hồi quy tuyến tính cho thấy có một mối quan hệ tích cực và ý nghĩa thống kê giữa GDP per capita của Việt Nam và Hoa Kỳ. Mỗi đơn vị tăng của GDP per capita của Việt Nam tương ứng với tăng khoảng 14.805 đơn vị trong GDP per capita của Hoa Kỳ.

4.3 Thực hành với bộ data VerbAgg

Ở tiết học, thầy có cho thực hành với bộ dataset VerbAgg như là mã hóa dữ liệu,sau đó chuyển dữ liệu dài sang dữ liệu rộng như sau:

library(lme4)
data("VerbAgg")
verbagg <- VerbAgg

verbagg <- verbagg %>% mutate(respn = case_when(resp == "no"~0,resp=="perhaps"~1,resp=="yes"~1))
resp_wide <- verbagg %>% select(id,item,respn) %>% pivot_wider(names_from = item,values_from = respn)
head(resp_wide)

## # A tibble: 6 × 25
##   id    S1WantCurse S1WantScold S1WantShout S2WantCurse S2WantScold S2WantShout
##   <fct>       <dbl>       <dbl>       <dbl>       <dbl>       <dbl>       <dbl>
## 1 1               0           0           0           0           0           0
## 2 2               0           0           0           0           0           0
## 3 3               1           1           1           1           0           1
## 4 4               1           1           1           1           1           1
## 5 5               1           0           1           1           0           0
## 6 6               1           1           0           1           0           0
## # ℹ 18 more variables: S3WantCurse <dbl>, S3WantScold <dbl>, S3WantShout <dbl>,
## #   S4wantCurse <dbl>, S4WantScold <dbl>, S4WantShout <dbl>, S1DoCurse <dbl>,
## #   S1DoScold <dbl>, S1DoShout <dbl>, S2DoCurse <dbl>, S2DoScold <dbl>,
## #   S2DoShout <dbl>, S3DoCurse <dbl>, S3DoScold <dbl>, S3DoShout <dbl>,
## #   S4DoCurse <dbl>, S4DoScold <dbl>, S4DoShout <dbl>

table(resp_wide$S1WantCurse)

## 
##   0   1 
##  91 225

prop.table(table(resp_wide$S1WantCurse))

## 
##         0         1 
## 0.2879747 0.7120253

Mục đích thao tác này để chuyển đổi dữ liệu từ dạng dài sang dạng rộng dựa trên biến id, item, respn (biến mã hóa của resp) với các cột biến mới là mục các câu hỏi(item) và các giá trị là của biến respn. Đều này sẽ thống kê được các mức độ trả lời các câu hỏi của khảo sát là không đồng ý, có thể hay là đồng ý. Ví dụ ở item S1WantCurse thì có 91 người không đồng ý chiếm 28,8% và có 225 người đồng ý hoặc có thể đồng ý chiếm 71,2%. Hoặc ta có thể lọc ra từng người trả lời các câu hỏi như thế nào.

resp_wide[1,2]

## # A tibble: 1 × 1
##   S1WantCurse
##         <dbl>
## 1           0

Kết quả: cho biết dòng 1 cột 2 (người có id=1 và cột S1WantCurse) câu trả lời là 0 tương ứng “no”.

type_wide <- verbagg %>% select(id,item,r2) %>% pivot_wider(names_from = item,values_from = r2)
head(type_wide)

## # A tibble: 6 × 25
##   id    S1WantCurse S1WantScold S1WantShout S2WantCurse S2WantScold S2WantShout
##   <fct> <fct>       <fct>       <fct>       <fct>       <fct>       <fct>      
## 1 1     N           N           N           N           N           N          
## 2 2     N           N           N           N           N           N          
## 3 3     Y           Y           Y           Y           N           Y          
## 4 4     Y           Y           Y           Y           Y           Y          
## 5 5     Y           N           Y           Y           N           N          
## 6 6     Y           Y           N           Y           N           N          
## # ℹ 18 more variables: S3WantCurse <fct>, S3WantScold <fct>, S3WantShout <fct>,
## #   S4wantCurse <fct>, S4WantScold <fct>, S4WantShout <fct>, S1DoCurse <fct>,
## #   S1DoScold <fct>, S1DoShout <fct>, S2DoCurse <fct>, S2DoScold <fct>,
## #   S2DoShout <fct>, S3DoCurse <fct>, S3DoScold <fct>, S3DoShout <fct>,
## #   S4DoCurse <fct>, S4DoScold <fct>, S4DoShout <fct>

Mục đích thao tác này để chuyển đổi dữ liệu từ dạng dài sang dạng rộng dựa trên biến id, item, r2 với các cột biến mới là mục các câu hỏi(item) và các giá trị là của biến r2. Điều này sẽ thống kê được các mức độ trả lời câu hỏi khảo sát với hai mức độ là yes hoặc no.

5 TUẦN 2

Package: Ecdat - Datasets: BudgetUK(Budget Shares of British Household

Mô tả dữ liệu

Số quan sát : 1519

Quan sát : Hộ gia đình

Quốc gia : Vương quốc Anh

Dữ liệu có chứa :

1. wfood: tỷ lệ chi tiêu ngân sách dành cho thực phẩm.

2. wfuel: tỷ lệ chi tiêu ngân sách dành cho chi phí nhiên liệu

3. wcloth: tỷ lệ chi tiêu ngân sách dành cho quần áo thời trang

4. walc: tỷ lệ chi ngân sách chi cho rượu

5. wtrans: tỷ lệ chi tiêu ngân sách dành cho chi phí phương tiện, giao thông vận tải

6. wother: tỷ lệ chi tiêu ngân sách cho các yếu tố khác

7. totexp: tổng chi tiêu hộ gia đình (Được làm tròn đến số tiền gần nhất theo đơn vị 10 bảng Anh)

8. income: tổng thu nhập ròng của hộ gia đình (Được làm tròn đến số tiền gần nhất theo đơn vị 10 bảng Anh)

9. age: tuổi của chủ hộ

10. children: số con trong hộ gia đình

Ở tuần trước, em đã thực hiện các thao tác cơ bản trên dữ liệu bao gồm gán biến mới, thêm cột vào dataframes, lọc dữ liệu,..Ở tuần này em sẽ thực hiện tính toán các thống kê mô tả( trung bình, trung vị, phương sai, độ lệch chuẩn,…), phân tổ dữ liệu không đều,thực hiện các thao tác phân tích và kiểm tra biến này có ảnh hưởng biến kia không, cách tính toán tần suất trên bảng tần số,… Ngoài ra còn thực hành toán tử %>% trong gói packages tidyverse, các thao tác ghép dữ liệu theo dòng cột.

Đầu tiên, em sẽ tải và kích hoạt lại gói package Ecdat chứa bộ dữ liệu, sau đó gán lại bộ dữ liệu vào một dataframes mới có tên là BUK. Để dễ dàng thao tác, nên đổi lại tên các biến lần lượt là ‘TP’, ‘NL’, ‘QA’, ‘R’, ‘PT’, ‘K’, ‘TC’, ‘TT’, ‘T’, ‘TE’.

library(Ecdat)

BUK <- BudgetUK
names(BUK) <- c('TP','NL','QA','R','PT','K','TC','TT','T','TE')

5.1 Tính toán các thống kê mô tả

5.1.1 Dùng hàm summary()

Dùng hàm summary để tóm tắt thống kê cho toàn bộ dữ liệu. Qua đó, ta có thể đọc được các giá trị về giá trị nhỏ nhất, giá trị lớn nhất, tứ phân vị, trung bình, trung vị cho từng biến có trong bộ data. Nếu muốn quan sát riêng, thì ta dùng $ để gọi biến có trong data đó.

summary(BUK$TT)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    20.0   100.0   120.0   136.2   160.0  1110.0

summary(BUK$TC)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    30.0    70.0    90.0    98.7   120.0   390.0

summary(BUK$T)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   19.00   30.00   35.00   35.78   40.00   60.00

summary(BUK$TE)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   1.000   1.000   2.000   1.609   2.000   2.000

Khi thực hiện dòng lệnh summary(BUK$TT) ta thu được giá trị nhỏ nhất của tổng thu nhập trong các hộ gia đình là 20, giá trị lớn nhất là 1110, mức trung bình là 136.2, có 25% số hộ gia đình có mức thu nhập nhỏ hơn 100, có 50 % số hộ gia đình có mức thu nhập dưới 120 và có 75% số hộ gia đình có mức thu nhập nhỏnhỏ hơn 160 (tính theo đơn vị 10 bảng Anh gần nhất).

Tương tự, dòng lệnh summary(BUK$TC) cho ta biết được hộ gia đình có mức chi tiêu nhỏ nhất là 30, hộ gia đình có mức chi tiêu lớn nhất là 390, mức chi tiêu trung bình là 98.7, có 25% số hộ gia đình chi tiêu dưới 70, có 50% số hộ gia đình có mức chi tiêu dưới 90 và có 75% số hộ gia đình có mức chi tiêu dưới 120(tính theo đơn vị 10 bảng Anh gần nhất).

Độ tuổi chủ hộ gia đình trong quan sát nhỏ nhất là 19, lớn nhất là 60, có 25% số người chủ hộ gia đình nhỏ hơn 30 tuổi có 50% số chủ hộ gia đình nhỏ hơn 35 tuổi, có 75% số người chủ hộ gia đình nhỏ hơn 40 tuổi. Độ tuổi trung bình trong khảo sát là 35.78~36. Số con trong hộ gia đình có nhiều nhất 2 con và ít nhất 1 con.

filtered_data <- BUK[, c("TP","NL","QA","R","PT","K")]
columns <- colnames(filtered_data)
mydata <- list()
for (col in columns) {
  mydata[[col]] <- filtered_data[, col] * BUK$TC
}
mydata <- as.data.frame(mydata)
names(mydata)<- c("TP1","NL1","QA1","R1","PT1","K1")
BUK <- cbind(BUK, mydata)
str(BUK)

## 'data.frame':    1519 obs. of  16 variables:
##  $ TP : num  0.427 0.374 0.194 0.444 0.333 ...
##  $ NL : num  0.1342 0.1686 0.4056 0.1258 0.0824 ...
##  $ QA : num  0 0.0091 0.0012 0.0539 0.0399 ...
##  $ R  : num  0.0106 0.0825 0.0513 0.0397 0.1571 ...
##  $ PT : num  0.1458 0.1215 0.2063 0.0652 0.2403 ...
##  $ K  : num  0.282 0.244 0.141 0.272 0.147 ...
##  $ TC : num  50 90 180 80 90 70 140 50 100 90 ...
##  $ TT : num  130 150 230 100 100 70 190 100 260 110 ...
##  $ T  : num  25 39 47 33 31 24 46 25 30 41 ...
##  $ TE : num  2 2 2 2 1 1 1 1 1 1 ...
##  $ TP1: num  21.4 33.7 34.9 35.5 30 ...
##  $ NL1: num  6.71 15.17 73.01 10.06 7.42 ...
##  $ QA1: num  0 0.819 0.216 4.312 3.591 ...
##  $ R1 : num  0.53 7.43 9.23 3.18 14.14 ...
##  $ PT1: num  7.29 10.94 37.13 5.22 21.63 ...
##  $ K1 : num  14.1 22 25.5 21.7 13.3 ...

Do các yếu tố ban đầu của bộ dữ liệu các mức chi tiêu theo tỷ lệ, nên em sẽ đưa về phần ngân sách cụ thể chi cho các yếu tố như là thực phẩm, nhiên liệu, quần áo, rượu, phương tiện và các chi tiêu khác bằng cách lấy cột tỷ lệ nhân cho cộng tổng chi tiêu(TC) sử dụng vòng lệnh for để áp dụng cho các cột tỷ lệ còn lại. Sau đó, ghép các cột dữ liệu mới tạo vào data ban đầu bằng lệnh cbind().

5.1.2 Các hàm mean() tính trung bình, var() phương sai, quantile()

mean(BUK$TP1)

## [1] 33.00888

mean(BUK$QA1)

## [1] 11.83112

Ngân sách chi tiêu trung bình của các hộ gia đình dành cho thực phẩm là 33.00888. Chi tiêu trung bình dành cho quần áo là 11.83112

var (BUK$NL1)

## [1] 30.25756

var(BUK$R1)

## [1] 57.5824

sd(BUK$K1)

## [1] 18.86031

30.25756 đại diện cho mức độ phân tán của các giá trị chi tiêu ngân sách cho yếu tố nhiên liệu quanh giá trị trung bình; 57.5824 đại diện cho mức độ phân tán của các giá trị chi tiêu ngân sách cho yếu tố rượu quanh giá trị trung bình; 18.86031: Độ lệch chuẩn đo lường mức độ phân tán của các giá trị của biến K1( chi tiêu cho các yếu tố khác) trong tập dữ liệu.

quantile(BUK$PT1,0.45)

##    45% 
## 9.2719

quantile(BUK$K1,0.57)

##      57% 
## 22.60134

Có 45% hộ gia đình có mức chi tiêu ngân sách cho phương tiện dưới mức 9.2719. có 57% hộ gia đình có mức ngân sách dành cho các chi tiêu khác dưới 22.60134.

5.1.3 Dùng hàm sum()

Dùng sum() để tính toán tổng phần ngân sách chi tiêu các hộ gia đình ở Anh cho thực phẩm, chi phí nhiên liệu, quần áo, chi tiêu cho rượu, phương tiện giao thông và các chi tiêu tốt khác.

sum(BUK$TP1)

## [1] 50140.49

sum(BUK$NL1)

## [1] 12557.72

sum(BUK$QA1)

## [1] 17971.47

sum(BUK$R1)

## [1] 9484.731

sum(BUK$PT1)

## [1] 20865.89

sum(BUK$K1)

## [1] 38899.5

Qua đó, kết luận được phần ngân sách chi tiêu cho yếu tố nào nhiều nhất. Kết luận: phần ngân sách chi tiêu cho thực phẩm ở các hộ gia đình ở Anh là cao nhất. có hai cách tính, bên trên là dùng sum cho từng cột biến hoặc có thể dùng vòng lặp tính cho tất cả sau đó dùng hàm max lọc ra giá trị lớn nhất cần tìm.

#sử dụng vòng lặp
chon <- c("TP","NL","QA","R","PT","K","T", "TE","Tcoded","TC","TT")
data <- BUK[, !(colnames(BUK) %in% chon)]
columns <- colnames(data)
sum_result <- list()
for (col in columns) {
  sum_result[[col]] <- sum(BUK[,col])
}
for (col in columns) {
  print(paste("Kết quả tính tổng chi tiêu hộ gia đình cho", col))
  print(sum_result[[col]])
}

## [1] "Kết quả tính tổng chi tiêu hộ gia đình cho TP1"
## [1] 50140.49
## [1] "Kết quả tính tổng chi tiêu hộ gia đình cho NL1"
## [1] 12557.72
## [1] "Kết quả tính tổng chi tiêu hộ gia đình cho QA1"
## [1] 17971.47
## [1] "Kết quả tính tổng chi tiêu hộ gia đình cho R1"
## [1] 9484.731
## [1] "Kết quả tính tổng chi tiêu hộ gia đình cho PT1"
## [1] 20865.89
## [1] "Kết quả tính tổng chi tiêu hộ gia đình cho K1"
## [1] 38899.5

max(unlist(sum_result))

## [1] 50140.49

Giải thích vòng lặp for: biến chon sẽ chứa tên các cột mà chúng ta cần loại bỏ ra khỏi dữ liệu để không tính toán, data là bộ dữ liệu mới chứa các cột sau khi đã loại bỏ dữ liệu, columns chứa tên các cột cần thực hiện phép tính, sau đó tạo một list mới sum_result để dán kết quả và sau đó ta dùng lệnh for. Sử dụng vòng lặp để hạn chế việc kết quả tính tổng riêng lẻ và trả đúng về kết quả lớn nhất cho mức chi tiêu của các hộ gia đình ở nhu cầu nào cao nhất.

5.2 Phân tổ không đều

Phân tổ tuổi chủ hộ gia đình. Phân thành 3 tổ như sau độ tuổi [19-30] gọi là trẻ tuổi, độ tuổi (30-50] gọi là trung niên, độ tuổi (50-60] gọi là cao tuổi, sau đó gán biến mới vào data(BUK) cột biến mới có tên là Tcoded, tạo nên dữ liệu có 1519 quan sát và gồm 17 biến. Mục đích là để phân nhóm ra được từng nhóm tuổi khác nhau theo từng mức độ sau đó phân tích dự ảnh hưởng của từ nhóm tuổi lên tổng chi tiêu và tổng thu nhập,…

BUK$Tcoded <- cut(BUK$T, breaks=c(18.95,30,50,60),labels=c('tre tuoi','trung nien','cao tuoi'))

Phân tổ các cột biến

tp1cut<-  cut(BUK$TP1, breaks=c(5,30,90,150),labels=c('thap','vua','cao'))

5.3 Tạo bảng tần số và tuần suất giữa các biến

5.3.1 Tạo bảng tần số và tần suất biến số con trong hộ gia đình và biến chi tiêu ngân sách cho thực phẩm.

table(BUK$TE,tp1cut)

##    tp1cut
##     thap vua cao
##   1  344 250   0
##   2  344 578   3

x=table(BUK$TE,tp1cut)
prop.table(x)

##    tp1cut
##            thap         vua         cao
##   1 0.226464779 0.164581962 0.000000000
##   2 0.226464779 0.380513496 0.001974984

Nhận xét: với mức chi tiêu thấp, thì tỷ lệ hộ gia đình chi tiêu ngân sách cho thực phẩm là như nhau chiếm 22.65%. Ở mức chi tiêu vừa phải, thì số hộ gia đình có 2 con chiếm tỷ lệ cao hơn và cao hơn xấp xỉ 21,6%. Ở nhóm có mức chi tiêu cao nhất thì mức chi tiêu hộ gia đình có 2 con hơn chiếm hơn 0,2%.

prop.table(table(BUK$Tcoded))

## 
##   tre tuoi trung nien   cao tuoi 
## 0.26333114 0.68861093 0.04805793

Nhận xét: do bảng số liệu số người trung niên chiếm tỉ lệ cao( chiếm 68.86%), nên việc phân tích ta sẽ chia thành các nhóm riêng và so sánh trên từng nhóm.

5.3.2 Tạo bảng tần số và tần suất biến số con trong hộ gia đình và biến chi tiêu ngân sách thực phẩm cho từng nhóm tuổi.

table(BUK$TE,tp1cut,BUK$Tcoded)

## , ,  = tre tuoi
## 
##    tp1cut
##     thap vua cao
##   1  141  74   0
##   2   99  86   0
## 
## , ,  = trung nien
## 
##    tp1cut
##     thap vua cao
##   1  182 148   0
##   2  241 473   2
## 
## , ,  = cao tuoi
## 
##    tp1cut
##     thap vua cao
##   1   21  28   0
##   2    4  19   1

x=table(BUK$TE,tp1cut,BUK$Tcoded)
prop.table(x)

## , ,  = tre tuoi
## 
##    tp1cut
##             thap          vua          cao
##   1 0.0928242265 0.0487162607 0.0000000000
##   2 0.0651744569 0.0566161949 0.0000000000
## 
## , ,  = trung nien
## 
##    tp1cut
##             thap          vua          cao
##   1 0.1198156682 0.0974325214 0.0000000000
##   2 0.1586570112 0.3113890718 0.0013166557
## 
## , ,  = cao tuoi
## 
##    tp1cut
##             thap          vua          cao
##   1 0.0138248848 0.0184331797 0.0000000000
##   2 0.0026333114 0.0125082291 0.0006583278

Bảng tuần suất này chia ra từng nhóm tuổi thì mức chi tiêu dành cho thực phẩm ở hộ gia đình có con khác nhau như thế nào, ta đọc được kết quả như sau: Ở nhóm trẻ tuổi: ở mức chi tiêu thấp thì số hộ gia đình có 1 con thuộc nhóm này chiếm tỷ lệ cao hơn,với mức chi tiêu vừa thì số hộ gia đình có 2 con chiếm tỷ lệ cao hơn. Ở nhóm trung niên: ở mức chi tiêu thấp, vừa hay cao thì số hộ gia đình có 2 con thuộc nhóm này chiếm tỷ lệ cao hơn. Ở nhóm cao tuổi: ở mức chi tiêu thấp và vừa thì số hộ gia đình có 1 con thuộc nhóm này chiếm tỷ lệ cao hơn. Tuy nhiên, ở mức cao thì số hộ gia đình có 2 con chiếm tỷ lệ cao hơn so với số hộ gia đình có 1 con.

5.4 Phân tích sự khác biệt mức chi tiêu và thu nhập trung bình của từng nhóm tuổi

5.4.1 Phân tổ biến tuổi chủ hộ gia đình

Phân thành 3 tổ như sau độ tuổi [19-30] gọi là trẻ tuổi, độ tuổi (30-50] gọi là trung niên, độ tuổi (50-60] gọi là cao tuổi, sau đó gán biến mới vào data(BUK) cột biến mới có tên là Tcoded, tạo nên dữ liệu có 1519 quan sát và gồm 17 biến. Mục đích là để phân nhóm ra được từng nhóm tuổi khác nhau theo từng mức độ sau đó phân tích dự ảnh hưởng của từ nhóm tuổi lên tổng chi tiêu và tổng thu nhập,…

BUK$Tcoded <- cut(BUK$T, breaks=c(18.95,30,50,60),labels=c('tre tuoi','trung nien','cao tuoi'))

5.4.2 Lấy ra mức chi tiêu trung bình và thu nhập trung bình của từ độ tuổi. Lập bảng ANOVA

library(tidyverse)

b <- BUK %>% group_by(Tcoded) %>% summarise(TC_mean=mean(TC),TT_mean=mean(TT))
b

## # A tibble: 3 × 3
##   Tcoded     TC_mean TT_mean
##   <fct>        <dbl>   <dbl>
## 1 tre tuoi      84.6    112.
## 2 trung nien   104.     145.
## 3 cao tuoi     105.     139.

model <- aov(TC ~ Tcoded, data = BUK)
summary(model)

##               Df  Sum Sq Mean Sq F value   Pr(>F)    
## Tcoded         2  108099   54050   30.08 1.54e-13 ***
## Residuals   1516 2723920    1797                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

model1 <- aov(TT ~ Tcoded, data = BUK)
summary(model1)

##               Df  Sum Sq Mean Sq F value Pr(>F)    
## Tcoded         2  310959  155479   44.07 <2e-16 ***
## Residuals   1516 5348852    3528                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Từ đó, ta nhận xét được Pr(>F): giá trị p-value là 1.54e-13 và <2e-16, rất nhỏ hơn mức ý nghĩa thông thường 0.05. Điều này cho thấy có sự khác biệt đáng kể giữa chi tiêu và thu nhập các nhóm tuổi trong biến “Tcoded”. Mức chi tiêu trung bình của các nhóm tuổi có xu hướng tăng dần từ nhóm trẻ tuổi đến nhóm trung niên và nhóm cao tuổi( người trẻ tuổi có chi tiêu trung bình là 84,6 thấp nhất và cao nhất là người cao tuổi 105,3425). Tuy nhiên, mức thu nhập trung bình có sự biến động khác nhau giữa các nhóm tuổi, ngươì có độ tuổi trung niên có trung bình tổng thu nhập cao nhất.

5.4.3 Vẽ đồ thị

ggplot(b) +
  geom_col(aes(x = Tcoded, y = TT_mean, fill = "Thu nhập"), position = "dodge") +
  geom_col(aes(x = Tcoded, y = TC_mean, fill = "Chi tiêu"), position = "dodge") +
  labs(x = "Nhóm", y = "Giá trị") +
  ggtitle("Mức chi tiêu và thu nhập trung bình giữa các nhóm tuổi") +
  scale_fill_manual(values = c("Chi tiêu" = "pink", "Thu nhập" = "gray")) +
  theme_minimal()

5.5 So sánh mức chi tiêu và thu nhập trung bình giữa số hộ gia đình có số lượng con khác nhau

5.5.1 Lấy ra mức chi tiêu trung bình và thu nhập trung bình của từ độ tuổi. Lập bảng ANOVA

bu <- BUK %>% group_by(TE) %>% summarise(TC_mean=mean(TC),TT_mean=mean(TT))
bu

## # A tibble: 2 × 3
##      TE TC_mean TT_mean
##   <dbl>   <dbl>   <dbl>
## 1     1    94.8    134.
## 2     2   101.     137.

mo <- aov(TC ~ TE, data = BUK)
summary(mo)

##               Df  Sum Sq Mean Sq F value  Pr(>F)   
## TE             1   14444   14444   7.777 0.00536 **
## Residuals   1517 2817575    1857                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

mo1 <- aov(TT ~ TE, data = BUK)
summary(mo1)

##               Df  Sum Sq Mean Sq F value Pr(>F)
## TE             1    3663    3663   0.982  0.322
## Residuals   1517 5656148    3729

Dựa vào kết quả ANOVA ta thấy được giá trị p-value là 0.00536, nhỏ hơn mức ý nghĩa 0.05, cho thấy có sự khác biệt đáng kể về mức chi tiêu của các hộ gia đình có số con khác nhau, hộ gia đình có nhiều con hơn thì mức chi tiêu trung bình cao hơn. Tuy nhiên, Giá trị p-value 0.322 lớn hơn mức ý nghĩa 0.05, cho thấy không có đủ bằng chứng thống kê để kết luận rằng số con trong hộ gia đình có ảnh hưởng đáng kể đến mức thu nhập.

5.5.2 Vẽ đồ thị

ggplot(bu, aes(x = TE, y = TC_mean)) +
  geom_col() +
  labs(x = "Nhóm", y = "Mức chi tiêu") +
  ggtitle("Mức chi tiêu trung bình các hộ gia đình theo Số trẻ em") +
  theme_minimal()

5.6 Hàm aggregate - Toán tử %>%

5.6.1 Hàm aggregate

aggregate(BUK$TP1,list(BUK$Tcoded),FUN ='mean')

##      Group.1        x
## 1   tre tuoi 28.77565
## 2 trung nien 34.33578
## 3   cao tuoi 37.19184

aggregate(BUK$NL1,list(BUK$Tcoded),FUN ='mean')

##      Group.1        x
## 1   tre tuoi 7.259642
## 2 trung nien 8.668210
## 3   cao tuoi 8.039986

aggregate(BUK$QA1,list(BUK$Tcoded),FUN ='mean')

##      Group.1        x
## 1   tre tuoi  9.79728
## 2 trung nien 12.53433
## 3   cao tuoi 12.89940

aggregate(BUK$R1,list(BUK$Tcoded),FUN ='mean')

##      Group.1        x
## 1   tre tuoi 6.733998
## 2 trung nien 6.103277
## 3   cao tuoi 5.576767

aggregate(BUK$PT1,list(BUK$Tcoded),FUN ='mean')

##      Group.1        x
## 1   tre tuoi 10.69201
## 2 trung nien 14.84170
## 3   cao tuoi 14.58459

aggregate(BUK$K1,list(BUK$Tcoded),FUN ='mean')

##      Group.1        x
## 1   tre tuoi 21.34142
## 2 trung nien 27.13985
## 3   cao tuoi 27.04997

aggregate(BUK$TC,list(BUK$Tcoded),FUN ='mean')

##      Group.1        x
## 1   tre tuoi  84.6000
## 2 trung nien 103.6233
## 3   cao tuoi 105.3425

aggregate(BUK$TT,list(BUK$Tcoded),FUN ='mean')

##      Group.1        x
## 1   tre tuoi 112.4250
## 2 trung nien 145.1816
## 3   cao tuoi 138.7671

Hàm aggregate giúp tổng hợp dữ liệu theo nhóm. Các câu lệnh phía trên sẽ trả về kết quả tổng hợp mức chi tiêu trung bình cho từng nhu cầu của hộ gia đình về thực phẩm, nhiên liệu, quần áo,rượu,chi phí giao thông vận tải và các chi tiêu khác, theo các nhóm tuổi khác nhau. Nếu muốn tổng hợp theo sum, var, min,..thì đổi FUN =“” Các giá trị mà ta muốn tổng hợp. ví dụ:

aggregate(BUK$TP1,list(BUK$Tcoded),FUN ='mean')

##      Group.1        x
## 1   tre tuoi 28.77565
## 2 trung nien 34.33578
## 3   cao tuoi 37.19184

Mức chi tiêu trung bình của từng nhóm tuổi dành cho thực phẩm. người trẻ tuổi chi trung bình 28.77565 dành cho thực phẩm, người có độ tuổi trung niên chi tiêu 34.33578 dành cho thực phầm và người cao tuổi chi 37.19184.

aggregate(BUK$TP1,list(BUK$Tcoded),FUN ='var')

##      Group.1         x
## 1   tre tuoi  92.08028
## 2 trung nien 155.03727
## 3   cao tuoi 287.93118

Phân tích độ biến động của mức chi tiêu dành cho thực phẩm ở các nhóm tuổi. Giá trị 287.93118 Giá trị này cho thấy mức độ biến động của mức chi tiêu dành cho thực phẩm trong nhóm “cao tuổi” là cao

aggregate(BUK$TP1,list(BUK$Tcoded),FUN ='sd')

##      Group.1         x
## 1   tre tuoi  9.595847
## 2 trung nien 12.451396
## 3   cao tuoi 16.968535

Với giá trị độ lệch chuẩn 16.968535, nó cho thấy sự biến động của mức chi tiêu trong nhóm “cao tuổi” là khá lớn. Điều này có nghĩa là giá trị của mức chi tiêu cho thực phẩm trong nhóm này có xu hướng phân tán xa khỏi giá trị trung bình của nó.

aggregate(BUK$QA1,list(BUK$TE),FUN ='mean')

##   Group.1        x
## 1       1 11.48539
## 2       2 12.05313

Mức chi tiêu dành cho quần áo ở cách hộ gia đình có số con khác nhau. hộ gia đình có 1 con thì mức chi tiêu trung bình cho quần áo là 11.48539 và ở hộ gia đình có 2 con mức chi tiêu trung bình là 12.05313. Nhưng để đánh giá các yếu số con có ảnh hưởng đến mức chi tiêu dành cho quần áo thì cần phải làm kiểm định ANOVA sau đó dùng p_value kết luận.

5.6.2 Toán tử %>%

Nếu chúng ta tổng hợp dữ liệu theo nhóm thì toán %>% cho cùng một kết quả với hàm aggregate và các con số cũng có ý nghĩa như là các con số của kết quả hàm aggregate.

BUK %>% group_by(Tcoded) %>% summarise(m=mean(TP1))

## # A tibble: 3 × 2
##   Tcoded         m
##   <fct>      <dbl>
## 1 tre tuoi    28.8
## 2 trung nien  34.3
## 3 cao tuoi    37.2

BUK %>% group_by(Tcoded) %>% summarise(m=var(TP1))

## # A tibble: 3 × 2
##   Tcoded         m
##   <fct>      <dbl>
## 1 tre tuoi    92.1
## 2 trung nien 155. 
## 3 cao tuoi   288.

BUK %>% group_by(Tcoded) %>% summarise(m=sd(TP1))

## # A tibble: 3 × 2
##   Tcoded         m
##   <fct>      <dbl>
## 1 tre tuoi    9.60
## 2 trung nien 12.5 
## 3 cao tuoi   17.0

BUK %>% group_by(TE) %>% summarise(m=mean(QA1))

## # A tibble: 2 × 2
##      TE     m
##   <dbl> <dbl>
## 1     1  11.5
## 2     2  12.1

5.7 Vòng lặp for để tính tổng hợp nhiều biến

5.7.1 Tổng hợp mức chi tiêu trung bình của các yếu tố theo nhóm tuổi.

chon1 <- c("TP","NL","QA","R","PT","K","T", "TE","Tcoded")
data1 <- BUK[, !(colnames(BUK) %in% chon1)]
columns <- colnames(data1)
my_result <- list()
for (col in columns) {
  my_result[[col]] <- aggregate(data1[, col], list(BUK$Tcoded), FUN = 'mean')
}
for (col in columns) {
  print(paste("Kết quả cho cột", col))
  print(my_result[[col]])
}

## [1] "Kết quả cho cột TC"
##      Group.1        x
## 1   tre tuoi  84.6000
## 2 trung nien 103.6233
## 3   cao tuoi 105.3425
## [1] "Kết quả cho cột TT"
##      Group.1        x
## 1   tre tuoi 112.4250
## 2 trung nien 145.1816
## 3   cao tuoi 138.7671
## [1] "Kết quả cho cột TP1"
##      Group.1        x
## 1   tre tuoi 28.77565
## 2 trung nien 34.33578
## 3   cao tuoi 37.19184
## [1] "Kết quả cho cột NL1"
##      Group.1        x
## 1   tre tuoi 7.259642
## 2 trung nien 8.668210
## 3   cao tuoi 8.039986
## [1] "Kết quả cho cột QA1"
##      Group.1        x
## 1   tre tuoi  9.79728
## 2 trung nien 12.53433
## 3   cao tuoi 12.89940
## [1] "Kết quả cho cột R1"
##      Group.1        x
## 1   tre tuoi 6.733998
## 2 trung nien 6.103277
## 3   cao tuoi 5.576767
## [1] "Kết quả cho cột PT1"
##      Group.1        x
## 1   tre tuoi 10.69201
## 2 trung nien 14.84170
## 3   cao tuoi 14.58459
## [1] "Kết quả cho cột K1"
##      Group.1        x
## 1   tre tuoi 21.34142
## 2 trung nien 27.13985
## 3   cao tuoi 27.04997

Trả về kết quả mức chi tiêu trung bình cho từng cột biến, sau đó đưa ra kết luận mức chi tiêu trung bình cho yếu tố nào là nhiều nhất. Kết quả, mức chi tiêu trung bình cho thực phẩm là cao nhất ở các nhóm tuổi trẻ tuổi, trung niên và cao tuổi. Trong các nhóm tuổi thì mức ngân sách chi tiêu trung bình cho thực phẩm của người cao tuổi là cao nhất.

5.7.2 Tổng hợp mức chi tiêu trung bình của các yếu tố theo số con trong hộ gia đình.

myme_result <- list()
for (col in columns) {
  myme_result[[col]] <- aggregate(data1[, col], list(BUK$TE), FUN = 'mean')
}
for (col in columns) {
  print(paste("Kết quả cho cột", col))
  print(myme_result[[col]])
}

## [1] "Kết quả cho cột TC"
##   Group.1         x
## 1       1  94.84848
## 2       2 101.16757
## [1] "Kết quả cho cột TT"
##   Group.1        x
## 1       1 134.3098
## 2       2 137.4919
## [1] "Kết quả cho cột TP1"
##   Group.1        x
## 1       1 29.87937
## 2       2 35.01854
## [1] "Kết quả cho cột NL1"
##   Group.1        x
## 1       1 7.986391
## 2       2 8.447360
## [1] "Kết quả cho cột QA1"
##   Group.1        x
## 1       1 11.48539
## 2       2 12.05313
## [1] "Kết quả cho cột R1"
##   Group.1        x
## 1       1 6.640722
## 2       2 5.989343
## [1] "Kết quả cho cột PT1"
##   Group.1        x
## 1       1 13.89150
## 2       2 13.63712
## [1] "Kết quả cho cột K1"
##   Group.1        x
## 1       1 24.96503
## 2       2 26.02191

Trả về kết quả mức chi tiêu trung bình cho từng cột biến mà em chọn ra, sau đó đưa ra kết luận mức chi tiêu trung bình cho yếu tố nào là nhiều nhất. kết quả bên dưới khi quan sát là mức chi tiêu trung bình cho thực phẩm là cao nhất ở nhóm hộ gia đình có một con và hộ gia đình có 2 con.

5.7.3 Tổng hợp mức chi tiêu tổng, trung bình, phương sai, max, min, độ lệch chuẩn của các yếu tố theo nhóm tuổi.

Các câu lệnh em viết sẽ cho kết quả tất cả các giá trị về sum, mean, var,… trên cùng một bảng. Qua đó, giúp chúng ta đọc được kết quả nhiều cột nhiều phép tính mà không phải thực hiện so sánh từng dòng lệnh riêng lẻ.

data_result <- list()
for (col in columns) {
  data_result[[col]] <- BUK %>%
    group_by(Tcoded) %>%
    summarise(across(all_of(col), list(sum=sum, mean = mean, var=var, max = max, min = min, sd=sd, n = length)))
}
for (col in columns) {
  print(paste("Kết quả cho cột", col))
  print(data_result[[col]])
}

## [1] "Kết quả cho cột TC"
## # A tibble: 3 × 8
##   Tcoded     TC_sum TC_mean TC_var TC_max TC_min TC_sd  TC_n
##   <fct>       <dbl>   <dbl>  <dbl>  <dbl>  <dbl> <dbl> <int>
## 1 tre tuoi    33840    84.6  1151.    260     30  33.9   400
## 2 trung nien 108390   104.   2002.    390     30  44.7  1046
## 3 cao tuoi     7690   105.   2392.    330     50  48.9    73
## [1] "Kết quả cho cột TT"
## # A tibble: 3 × 8
##   Tcoded     TT_sum TT_mean TT_var TT_max TT_min TT_sd  TT_n
##   <fct>       <dbl>   <dbl>  <dbl>  <dbl>  <dbl> <dbl> <int>
## 1 tre tuoi    44970    112.  1599.    460     20  40.0   400
## 2 trung nien 151860    145.  4271.   1110     20  65.3  1046
## 3 cao tuoi    10130    139.  3444.    340     30  58.7    73
## [1] "Kết quả cho cột TP1"
## # A tibble: 3 × 8
##   Tcoded     TP1_sum TP1_mean TP1_var TP1_max TP1_min TP1_sd TP1_n
##   <fct>        <dbl>    <dbl>   <dbl>   <dbl>   <dbl>  <dbl> <int>
## 1 tre tuoi    11510.     28.8    92.1    85.3    7.50   9.60   400
## 2 trung nien  35915.     34.3   155.     90.5    5.10  12.5   1046
## 3 cao tuoi     2715.     37.2   288.    146.    14.8   17.0     73
## [1] "Kết quả cho cột NL1"
## # A tibble: 3 × 8
##   Tcoded     NL1_sum NL1_mean NL1_var NL1_max NL1_min NL1_sd NL1_n
##   <fct>        <dbl>    <dbl>   <dbl>   <dbl>   <dbl>  <dbl> <int>
## 1 tre tuoi     2904.     7.26    20.6    65.2    0      4.54   400
## 2 trung nien   9067.     8.67    34.3    74.4    0      5.85  1046
## 3 cao tuoi      587.     8.04    18.3    28.4    1.95   4.27    73
## [1] "Kết quả cho cột QA1"
## # A tibble: 3 × 8
##   Tcoded     QA1_sum QA1_mean QA1_var QA1_max QA1_min QA1_sd QA1_n
##   <fct>        <dbl>    <dbl>   <dbl>   <dbl>   <dbl>  <dbl> <int>
## 1 tre tuoi     3919.     9.80    154.    94.1       0   12.4   400
## 2 trung nien  13111.    12.5     234.   240.        0   15.3  1046
## 3 cao tuoi      942.    12.9     225.    64.9       0   15.0    73
## [1] "Kết quả cho cột R1"
## # A tibble: 3 × 8
##   Tcoded     R1_sum R1_mean R1_var R1_max R1_min R1_sd  R1_n
##   <fct>       <dbl>   <dbl>  <dbl>  <dbl>  <dbl> <dbl> <int>
## 1 tre tuoi    2694.    6.73   56.2   50.1      0  7.50   400
## 2 trung nien  6384.    6.10   58.2   70.5      0  7.63  1046
## 3 cao tuoi     407.    5.58   55.8   38.6      0  7.47    73
## [1] "Kết quả cho cột PT1"
## # A tibble: 3 × 8
##   Tcoded     PT1_sum PT1_mean PT1_var PT1_max PT1_min PT1_sd PT1_n
##   <fct>        <dbl>    <dbl>   <dbl>   <dbl>   <dbl>  <dbl> <int>
## 1 tre tuoi     4277.     10.7    141.    105.       0   11.9   400
## 2 trung nien  15524.     14.8    321.    237.       0   17.9  1046
## 3 cao tuoi     1065.     14.6    362.    150.       0   19.0    73
## [1] "Kết quả cho cột K1"
## # A tibble: 3 × 8
##   Tcoded     K1_sum K1_mean K1_var K1_max K1_min K1_sd  K1_n
##   <fct>       <dbl>   <dbl>  <dbl>  <dbl>  <dbl> <dbl> <int>
## 1 tre tuoi    8537.    21.3   220.  113.    2.17  14.8   400
## 2 trung nien 28388.    27.1   400.  198.    1.98  20.0  1046
## 3 cao tuoi    1975.    27.0   339.   95.6   5.83  18.4    73

5.7.4 Tổng hợp mức chi tiêu tổng, trung bình, phương sai, max, min, độ lệch chuẩn của các yếu tố theo nhóm số con trong hộ gia đình.

edata_result <- list()
for (col in columns) {
  edata_result[[col]] <- BUK %>%
    group_by(TE) %>%
    summarise(across(all_of(col), list(sum=sum, mean = mean, var=var, max = max, min = min,sd=sd, n = length)))
}
for (col in columns) {
  print(paste("Kết quả cho cột", col))
  print(edata_result[[col]])
}

## [1] "Kết quả cho cột TC"
## # A tibble: 2 × 8
##      TE TC_sum TC_mean TC_var TC_max TC_min TC_sd  TC_n
##   <dbl>  <dbl>   <dbl>  <dbl>  <dbl>  <dbl> <dbl> <int>
## 1     1  56340    94.8  2124.    390     30  46.1   594
## 2     2  93580   101.   1686.    330     40  41.1   925
## [1] "Kết quả cho cột TT"
## # A tibble: 2 × 8
##      TE TT_sum TT_mean TT_var TT_max TT_min TT_sd  TT_n
##   <dbl>  <dbl>   <dbl>  <dbl>  <dbl>  <dbl> <dbl> <int>
## 1     1  79780    134.  4948.   1110     20  70.3   594
## 2     2 127180    137.  2946.    630     20  54.3   925
## [1] "Kết quả cho cột TP1"
## # A tibble: 2 × 8
##      TE TP1_sum TP1_mean TP1_var TP1_max TP1_min TP1_sd TP1_n
##   <dbl>   <dbl>    <dbl>   <dbl>   <dbl>   <dbl>  <dbl> <int>
## 1     1  17748.     29.9    122.    82.6    7.50   11.0   594
## 2     2  32392.     35.0    160.   146.     5.10   12.7   925
## [1] "Kết quả cho cột NL1"
## # A tibble: 2 × 8
##      TE NL1_sum NL1_mean NL1_var NL1_max NL1_min NL1_sd NL1_n
##   <dbl>   <dbl>    <dbl>   <dbl>   <dbl>   <dbl>  <dbl> <int>
## 1     1   4744.     7.99    27.6    74.4       0   5.26   594
## 2     2   7814.     8.45    31.9    73.0       0   5.65   925
## [1] "Kết quả cho cột QA1"
## # A tibble: 2 × 8
##      TE QA1_sum QA1_mean QA1_var QA1_max QA1_min QA1_sd QA1_n
##   <dbl>   <dbl>    <dbl>   <dbl>   <dbl>   <dbl>  <dbl> <int>
## 1     1   6822.     11.5    258.    240.       0   16.1   594
## 2     2  11149.     12.1    185.    122.       0   13.6   925
## [1] "Kết quả cho cột R1"
## # A tibble: 2 × 8
##      TE R1_sum R1_mean R1_var R1_max R1_min R1_sd  R1_n
##   <dbl>  <dbl>   <dbl>  <dbl>  <dbl>  <dbl> <dbl> <int>
## 1     1  3945.    6.64   59.1   70.5      0  7.69   594
## 2     2  5540.    5.99   56.5   64.2      0  7.52   925
## [1] "Kết quả cho cột PT1"
## # A tibble: 2 × 8
##      TE PT1_sum PT1_mean PT1_var PT1_max PT1_min PT1_sd PT1_n
##   <dbl>   <dbl>    <dbl>   <dbl>   <dbl>   <dbl>  <dbl> <int>
## 1     1   8252.     13.9    335.    237.       0   18.3   594
## 2     2  12614.     13.6    243.    190.       0   15.6   925
## [1] "Kết quả cho cột K1"
## # A tibble: 2 × 8
##      TE K1_sum K1_mean K1_var K1_max K1_min K1_sd  K1_n
##   <dbl>  <dbl>   <dbl>  <dbl>  <dbl>  <dbl> <dbl> <int>
## 1     1 14829.    25.0   418.   198.   1.98  20.4   594
## 2     2 24070.    26.0   316.   142.   3.34  17.8   925

5.8 Ma trận tương quan các biến và biểu đồ ma trận tương quan

cor_matrix <- cor(BUK[, c("TP1","NL1","QA1","R1","PT1","K1","TC","TT","T","TE")])
cor_matrix

##           TP1        NL1        QA1           R1          PT1         K1
## TP1 1.0000000 0.17023986 0.25849373  0.266349589  0.106160593 0.28419721
## NL1 0.1702399 1.00000000 0.04980046  0.105617503  0.042977804 0.16272403
## QA1 0.2584937 0.04980046 1.00000000  0.154890451  0.094618573 0.25392493
## R1  0.2663496 0.10561750 0.15489045  1.000000000  0.004508032 0.23571810
## PT1 0.1061606 0.04297780 0.09461857  0.004508032  1.000000000 0.14221182
## K1  0.2841972 0.16272403 0.25392493  0.235718101  0.142211819 1.00000000
## TC  0.6059238 0.29891451 0.59306244  0.422078843  0.517066102 0.72062411
## TT  0.2827166 0.28682930 0.20087204  0.189714204  0.163535373 0.38286543
## T   0.2361593 0.11574032 0.08376115 -0.049747250  0.076988429 0.13301810
## TE  0.2039058 0.04090765 0.01895870 -0.041902366 -0.007439590 0.02735437
##             TC         TT            T           TE
## TP1 0.60592384 0.28271664  0.236159292  0.203905778
## NL1 0.29891451 0.28682930  0.115740320  0.040907647
## QA1 0.59306244 0.20087204  0.083761145  0.018958695
## R1  0.42207884 0.18971420 -0.049747250 -0.041902366
## PT1 0.51706610 0.16353537  0.076988429 -0.007439590
## K1  0.72062411 0.38286543  0.133018102  0.027354368
## TC  1.00000000 0.44874035  0.189450718  0.071415282
## TT  0.44874035 1.00000000  0.218494045  0.025439105
## T   0.18945072 0.21849404  1.000000000  0.008092095
## TE  0.07141528 0.02543911  0.008092095  1.000000000

cor_data <- as.data.frame(as.table(cor_matrix))
colnames(cor_data) <- c("Var1", "Var2", "Correlation")
ggplot(data = cor_data, aes(x = Var1, y = Var2)) +
  geom_tile(aes(fill = Correlation)) +
  geom_text(aes(label = round(Correlation, 2)), color = "black", size = 3) +
  scale_fill_gradient2(low = "blue", mid = "white", high = "red", midpoint = 0) +
  theme_minimal()

Dựa vào ma trận tương quan của các biến, ta có thể đọc và kết luận được mức độ tương quan mạnh yếu giữa các biến khác nhau: Hệ số ma trận tương quan của biến tổng chi tiêu (TC) và biến thực phẩm (TP1) là 0.6059238 con số này cho thấy giá trị này là dương và có giá trị tương đối cao, điều này cho thấy rằng mức chi tiêu cho thực phẩm có xu hướng tăng cùng với mức tổng chi tiêu của hộ gia đình. Hệ số ma trận tương quan của biến tổng chi tiêu (TC) và biến mức chi ngân sách cho nhiên liệu(NL1) là 0.29891451 giá trị này là dương và có giá trị tương đối trung bình, điều này cho thấy rằng mức chi tiêu cho nhiên liệu có xu hướng tăng cùng với mức tổng chi tiêu của hộ gia đình, tuy nhiên mức độ tương quan không mạnh.

5.9 Tìm, lọc thông tin

TE1 <- BUK[BUK$TE==1,]
TE2 <- BUK[!BUK$TE==1,]

Tìm số hộ gia đình có chi tiêu lớn hơn thu nhập

ss <- BUK[BUK$TC>BUK$TT,]
head(ss)

##        TP     NL     QA      R     PT      K  TC  TT  T TE    TP1    NL1    QA1
## 18 0.2396 0.0383 0.0727 0.1182 0.1889 0.3423 150 140 38  2 35.940  5.745 10.905
## 35 0.2901 0.0496 0.0458 0.1176 0.2903 0.2066 150 140 38  2 43.515  7.440  6.870
## 52 0.3149 0.1078 0.1846 0.0674 0.1825 0.1429 100  80 30  2 31.490 10.780 18.460
## 55 0.1839 0.0611 0.0928 0.0046 0.0771 0.5805 190 170 49  1 34.941 11.609 17.632
## 70 0.5348 0.0653 0.1980 0.0473 0.0372 0.1173 130 110 33  2 69.524  8.489 25.740
## 72 0.4223 0.0995 0.1582 0.0666 0.0008 0.2526  90  80 28  2 38.007  8.955 14.238
##        R1    PT1      K1     Tcoded
## 18 17.730 28.335  51.345 trung nien
## 35 17.640 43.545  30.990 trung nien
## 52  6.740 18.250  14.290   tre tuoi
## 55  0.874 14.649 110.295 trung nien
## 70  6.149  4.836  15.249 trung nien
## 72  5.994  0.072  22.734   tre tuoi

Tìm số hộ gia đình có chi tiêu nhỏ hơn thu nhập và có số con trong gia đình là 1

ss1 <- BUK[BUK$TC<BUK$TT&BUK$TE==1,]
head(ss1)

##        TP     NL     QA      R     PT      K  TC  TT  T TE    TP1    NL1    QA1
## 5  0.3331 0.0824 0.0399 0.1571 0.2403 0.1473  90 100 31  1 29.979  7.416  3.591
## 7  0.2568 0.0909 0.0453 0.0153 0.0227 0.5689 140 190 46  1 35.952 12.726  6.342
## 8  0.4533 0.2105 0.1131 0.0161 0.0000 0.2070  50 100 25  1 22.665 10.525  5.655
## 9  0.3279 0.1053 0.1671 0.0293 0.0433 0.3272 100 260 30  1 32.790 10.530 16.710
## 10 0.4608 0.0612 0.0230 0.0338 0.1901 0.2310  90 110 41  1 41.472  5.508  2.070
## 19 0.2846 0.0405 0.1511 0.0000 0.1235 0.4003 120 140 45  1 34.152  4.860 18.132
##        R1    PT1     K1     Tcoded
## 5  14.139 21.627 13.257 trung nien
## 7   2.142  3.178 79.646 trung nien
## 8   0.805  0.000 10.350   tre tuoi
## 9   2.930  4.330 32.720   tre tuoi
## 10  3.042 17.109 20.790 trung nien
## 19  0.000 14.820 48.036 trung nien

Tìm số hộ gia đình có chi tiêu lớn hơn thu nhập hoặc số con trong hộ gia đình không phải là 1

ss2 <- BUK[BUK$TC>BUK$TT|!BUK$TE==1,]
head(ss2)

##        TP     NL     QA      R     PT      K  TC  TT  T TE    TP1    NL1    QA1
## 1  0.4272 0.1342 0.0000 0.0106 0.1458 0.2822  50 130 25  2 21.360  6.710  0.000
## 2  0.3739 0.1686 0.0091 0.0825 0.1215 0.2444  90 150 39  2 33.651 15.174  0.819
## 3  0.1941 0.4056 0.0012 0.0513 0.2063 0.1415 180 230 47  2 34.938 73.008  0.216
## 4  0.4438 0.1258 0.0539 0.0397 0.0652 0.2716  80 100 33  2 35.504 10.064  4.312
## 11 0.3447 0.0392 0.2547 0.0000 0.0672 0.2942 100 100 48  2 34.470  3.920 25.470
## 13 0.4439 0.1023 0.0018 0.0570 0.1190 0.2759  80 100 28  2 35.512  8.184  0.144
##       R1    PT1     K1     Tcoded
## 1  0.530  7.290 14.110   tre tuoi
## 2  7.425 10.935 21.996 trung nien
## 3  9.234 37.134 25.470 trung nien
## 4  3.176  5.216 21.728 trung nien
## 11 0.000  6.720 29.420 trung nien
## 13 4.560  9.520 22.072   tre tuoi

5.10 Mô phỏng dữ liệu

rpois() tạo một mẫu ngẫu nhiên từ phân phối Poisson; rnorm() tạo một mẫu ngẫu nhiên từ phân phối chuẩn.

t1 <- rpois(100,mean(BUK$NL1))
t1 <- as.data.frame(t1)
t1$tg <- seq(1,1,length = 100)
t2 <- rnorm(100, mean = mean(BUK$QA1), sd = sd(BUK$QA1))
t2 <- as.data.frame(t2)
t2$tg <- seq(2,2,length = 100)
t3 <-  rnorm(100, mean = mean(BUK$R1), sd = sd(BUK$R1))
t3 <- as.data.frame(t3)
t3$tg <- seq(3,3,length = 100)

Để có thể tổng hợp theo hàng ta phải đưa về cùng tên các cột thì mới tổng hợp được nên sử dụng lệnh for sau đó đổi tên thì nó sẽ trả về kết quả cả ba dataframes mà không phải đổi tên từng cái. Lệnh này thuận tiện cho việc dùng với nhiều bộ data hơn. Còn chỉ với ba bộ dữ liệu ta có thể đổi tên từng biến bằng cách t1 %>% rename(new = t1).

data <- list(t1,t2,t3)
new_column_name <- "new"
for (i in 1:length(data)) {
  colnames(data[[i]])[1] <- new_column_name
}

Dùng lệnh bind_rows để tổng hợp theo hàng.

tonghop <- bind_rows(data)

6 TUẦN 1

6.1 Các thao tác với dữ liệu.

Hiện các data sets có trong package ‘Ecdat’

data(package='Ecdat')

Tải và kích hoạt gói package Ecdat

library(Ecdat)

Dữ liệu của BudgetUK, gán BudgetUK vào b

data(BudgetUK)
b <- BudgetUK

Mô tả cấu trúc của data sets BudgetUK(b)

str(b)

## 'data.frame':    1519 obs. of  10 variables:
##  $ wfood   : num  0.427 0.374 0.194 0.444 0.333 ...
##  $ wfuel   : num  0.1342 0.1686 0.4056 0.1258 0.0824 ...
##  $ wcloth  : num  0 0.0091 0.0012 0.0539 0.0399 ...
##  $ walc    : num  0.0106 0.0825 0.0513 0.0397 0.1571 ...
##  $ wtrans  : num  0.1458 0.1215 0.2063 0.0652 0.2403 ...
##  $ wother  : num  0.282 0.244 0.141 0.272 0.147 ...
##  $ totexp  : num  50 90 180 80 90 70 140 50 100 90 ...
##  $ income  : num  130 150 230 100 100 70 190 100 260 110 ...
##  $ age     : num  25 39 47 33 31 24 46 25 30 41 ...
##  $ children: num  2 2 2 2 1 1 1 1 1 1 ...

Lấy 6 dòng đầu tiên của data setssets

head(b)

##    wfood  wfuel wcloth   walc wtrans wother totexp income age children
## 1 0.4272 0.1342 0.0000 0.0106 0.1458 0.2822     50    130  25        2
## 2 0.3739 0.1686 0.0091 0.0825 0.1215 0.2444     90    150  39        2
## 3 0.1941 0.4056 0.0012 0.0513 0.2063 0.1415    180    230  47        2
## 4 0.4438 0.1258 0.0539 0.0397 0.0652 0.2716     80    100  33        2
## 5 0.3331 0.0824 0.0399 0.1571 0.2403 0.1473     90    100  31        1
## 6 0.3752 0.0481 0.1170 0.0210 0.0955 0.3431     70     70  24        1

Gán các biến mới

food <- b$wfood
fuel <- b$wfuel
cloth <- b$wcloth
tong3 <- (food+fuel+cloth)

Tóm tắt thống kê biến wfood

summary(food)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  0.0571  0.2817  0.3540  0.3565  0.4258  0.7890

Phân tổ dữ liệu biến food thành 4 tổ gán vào food4

food4 <- cut(food,4)

Lập bảng tần số biến food4; lập bảng tần số biến giữa biến age và biến food4

table(cut(food,4))

## 
## (0.0564,0.24]  (0.24,0.423] (0.423,0.606]  (0.606,0.79] 
##           206           919           379            15

table(cut(b$age,4),food4)

##              food4
##               (0.0564,0.24] (0.24,0.423] (0.423,0.606] (0.606,0.79]
##   (19,29.2]              45          199            92            3
##   (29.2,39.5]           102          478           166            8
##   (39.5,49.8]            47          199            88            4
##   (49.8,60]              12           43            33            0

Tính toán tần suất bảng tần số food4

x=table(cut(b$age,4),food4)
prop.table(x)

##              food4
##               (0.0564,0.24] (0.24,0.423] (0.423,0.606] (0.606,0.79]
##   (19,29.2]     0.029624753  0.131007242   0.060566162  0.001974984
##   (29.2,39.5]   0.067149440  0.314680711   0.109282423  0.005266623
##   (39.5,49.8]   0.030941409  0.131007242   0.057932851  0.002633311
##   (49.8,60]     0.007899934  0.028308097   0.021724819  0.000000000

Lấy ra các dòng có biến age=25 và gán vào age25 tạo một biến mới

age25 <- b[b$age==25,]
head(age25)

##      wfood  wfuel wcloth   walc wtrans wother totexp income age children
## 1   0.4272 0.1342 0.0000 0.0106 0.1458 0.2822     50    130  25        2
## 8   0.4533 0.2105 0.1131 0.0161 0.0000 0.2070     50    100  25        1
## 33  0.4094 0.1293 0.1310 0.0000 0.0426 0.2877     60    100  25        2
## 73  0.4533 0.0674 0.0596 0.0000 0.0435 0.3763    130     90  25        1
## 106 0.3834 0.0557 0.1423 0.2379 0.0046 0.1760     80    170  25        2
## 111 0.4156 0.0691 0.0000 0.0154 0.2691 0.2308     90    110  25        2

Lấy ra các dòng có biến age >25 và children=1

age25cr1 <- b[b$age>25&b$children==1,]

số quan sát và số lượng biến trong age25cr1

dim(age25cr1)

## [1] 515  10

Lấy ra các dòng có biến age <25 hoặc children=2

age25cr2 <- b[b$age<25|b$children==2,]
str(age25cr2)

## 'data.frame':    982 obs. of  10 variables:
##  $ wfood   : num  0.427 0.374 0.194 0.444 0.375 ...
##  $ wfuel   : num  0.1342 0.1686 0.4056 0.1258 0.0481 ...
##  $ wcloth  : num  0 0.0091 0.0012 0.0539 0.117 ...
##  $ walc    : num  0.0106 0.0825 0.0513 0.0397 0.021 ...
##  $ wtrans  : num  0.1458 0.1215 0.2063 0.0652 0.0955 ...
##  $ wother  : num  0.282 0.244 0.141 0.272 0.343 ...
##  $ totexp  : num  50 90 180 80 70 100 100 80 40 70 ...
##  $ income  : num  130 150 230 100 70 100 100 100 120 130 ...
##  $ age     : num  25 39 47 33 24 48 24 28 31 47 ...
##  $ children: num  2 2 2 2 1 2 1 2 2 2 ...

Xem dữ liệu dòng 101 biến income

b$income[101]

## [1] 90

b[101,8]

## [1] 90

Đổi tên các biến

names(b) <- c('TP','NL','QA','R','PT','K','TC','TT','T','TE')

Lấy ngẫu nhiên 2 dòng

b1 <- b[sample(nrow(b), 2), ]
b1

##          TP     NL     QA      R     PT      K  TC  TT  T TE
## 1488 0.4385 0.0701 0.0233 0.1559 0.1897 0.1225  90 110 48  1
## 1276 0.3540 0.0429 0.0766 0.2334 0.0847 0.2084 170 210 36  2

Thêm cột vào data sets ban đầu

b$logR <- log(b$R)
b$tong <- b$TP+b$NL+b$QA+b$R+b$PT+b$K
head(b$tong)

## [1] 1.0000 1.0000 1.0000 1.0000 1.0001 0.9999

Vẽ đồ thị đường

library(foreign)
plot(b$TT, type = "l", col = "blue", xlab = "",ylab = "Thu nhap", main = "TỔNG THU NHẬP CỦA HỘ GIA ĐÌNH")