1 7. Scientific Publications by Country

Tạo một tập dữ liệu gồm số lượng công bố khoa học của 5 quốc gia trong giai đoạn 2015–2017.

df <- data.frame(
  Country = c(
    "Vietnam",
    "Thailand",
    "Malaysia",
    "Indonesia",
    "Singapore"
  ),
  Pubs = c(
    17178,
    42914,
    71229,
    19585,
    69883
  )
)

df
##     Country  Pubs
## 1   Vietnam 17178
## 2  Thailand 42914
## 3  Malaysia 71229
## 4 Indonesia 19585
## 5 Singapore 69883

Vẽ biểu đồ cột thể hiện số lượng công bố khoa học của từng quốc gia.

ggplot(
  df,
  aes(
    x = Country,
    y = Pubs,
    fill = Country
  )
) +
  geom_col() +
  geom_text(
    aes(label = Pubs),
    vjust = -0.3
  ) +
  labs(
    title = "Scientific Publications by Country (2015-2017)",
    x = "Country",
    y = "Number of Publications"
  ) +
  theme_minimal() +
  theme(
    legend.position = "none"
  )

2 8. NHANES Data

2.1 8.1 Đọc dữ liệu NHANES

Đọc dữ liệu NHANES từ package NHANES.

df1 <- NHANES

head(df1, 10)
## # A tibble: 10 × 76
##       ID SurveyYr Gender   Age AgeDecade AgeMonths Race1 Race3 Education   
##    <int> <fct>    <fct>  <int> <fct>         <int> <fct> <fct> <fct>       
##  1 51624 2009_10  male      34 " 30-39"        409 White <NA>  High School 
##  2 51624 2009_10  male      34 " 30-39"        409 White <NA>  High School 
##  3 51624 2009_10  male      34 " 30-39"        409 White <NA>  High School 
##  4 51625 2009_10  male       4 " 0-9"           49 Other <NA>  <NA>        
##  5 51630 2009_10  female    49 " 40-49"        596 White <NA>  Some College
##  6 51638 2009_10  male       9 " 0-9"          115 White <NA>  <NA>        
##  7 51646 2009_10  male       8 " 0-9"          101 White <NA>  <NA>        
##  8 51647 2009_10  female    45 " 40-49"        541 White <NA>  College Grad
##  9 51647 2009_10  female    45 " 40-49"        541 White <NA>  College Grad
## 10 51647 2009_10  female    45 " 40-49"        541 White <NA>  College Grad
## # ℹ 67 more variables: MaritalStatus <fct>, HHIncome <fct>, HHIncomeMid <int>,
## #   Poverty <dbl>, HomeRooms <int>, HomeOwn <fct>, Work <fct>, Weight <dbl>,
## #   Length <dbl>, HeadCirc <dbl>, Height <dbl>, BMI <dbl>,
## #   BMICatUnder20yrs <fct>, BMI_WHO <fct>, Pulse <int>, BPSysAve <int>,
## #   BPDiaAve <int>, BPSys1 <int>, BPDia1 <int>, BPSys2 <int>, BPDia2 <int>,
## #   BPSys3 <int>, BPDia3 <int>, Testosterone <dbl>, DirectChol <dbl>,
## #   TotChol <dbl>, UrineVol1 <int>, UrineFlow1 <dbl>, UrineVol2 <int>, …

Kiểm tra kích thước dữ liệu.

dim(df1)
## [1] 10000    76
cat("Số dòng:", nrow(df1), "\n")
## Số dòng: 10000
cat("Số cột:", ncol(df1), "\n")
## Số cột: 76

2.2 8.2 Tạo tập dữ liệu df2

Tạo tập dữ liệu mới df2 chỉ bao gồm các biến:

  • Age
  • Gender
  • Race1
  • Education
  • BMI
  • BMI_WHO
  • HHIncomeMid
  • Poverty
df2 <- NHANES[, c(
  "Age",
  "Gender",
  "Race1",
  "Education",
  "BMI",
  "BMI_WHO",
  "HHIncomeMid",
  "Poverty"
)]

head(df2, 10)
## # A tibble: 10 × 8
##      Age Gender Race1 Education      BMI BMI_WHO      HHIncomeMid Poverty
##    <int> <fct>  <fct> <fct>        <dbl> <fct>              <int>   <dbl>
##  1    34 male   White High School   32.2 30.0_plus          30000    1.36
##  2    34 male   White High School   32.2 30.0_plus          30000    1.36
##  3    34 male   White High School   32.2 30.0_plus          30000    1.36
##  4     4 male   Other <NA>          15.3 12.0_18.5          22500    1.07
##  5    49 female White Some College  30.6 30.0_plus          40000    1.91
##  6     9 male   White <NA>          16.8 12.0_18.5          87500    1.84
##  7     8 male   White <NA>          20.6 18.5_to_24.9       60000    2.33
##  8    45 female White College Grad  27.2 25.0_to_29.9       87500    5   
##  9    45 female White College Grad  27.2 25.0_to_29.9       87500    5   
## 10    45 female White College Grad  27.2 25.0_to_29.9       87500    5

Kiểm tra số dòng và số cột.

dim(df2)
## [1] 10000     8
cat("Số dòng:", nrow(df2), "\n")
## Số dòng: 10000
cat("Số cột:", ncol(df2), "\n")
## Số cột: 8

3 8.3 Data Visualization

3.1 8.3.1 Phân bố của HHIncomeMid

3.1.1 Histogram

Vẽ histogram mô tả phân bố của biến HHIncomeMid.

ggplot(
  df2,
  aes(x = HHIncomeMid)
) +
  geom_histogram(
    bins = 30,
    fill = "steelblue",
    color = "white",
    na.rm = TRUE
  ) +
  labs(
    title = "Distribution of Household Income",
    x = "Household Income",
    y = "Frequency"
  ) +
  theme_minimal()

3.1.2 Histogram kết hợp Density Curve

Biểu đồ histogram kết hợp đường mật độ nhằm thể hiện rõ hơn hình dạng phân bố của biến HHIncomeMid.

ggplot(
  df2,
  aes(x = HHIncomeMid)
) +
  geom_histogram(
    aes(y = after_stat(density)),
    bins = 30,
    fill = "skyblue",
    color = "white",
    alpha = 0.7,
    na.rm = TRUE
  ) +
  geom_density(
    color = "red",
    linewidth = 1.2,
    na.rm = TRUE
  ) +
  labs(
    title = "Household Income Distribution with Density",
    x = "Household Income",
    y = "Density"
  ) +
  theme_minimal()

3.2 8.3.2 Education Bar Chart

Vẽ biểu đồ cột thể hiện tần số của từng nhóm trình độ học vấn. Mỗi nhóm có màu khác nhau và trên mỗi cột hiển thị tần số.

ggplot(
  df2,
  aes(
    x = Education,
    fill = Education
  )
) +
  geom_bar(na.rm = TRUE) +
  geom_text(
    stat = "count",
    aes(label = after_stat(count)),
    vjust = -0.3,
    na.rm = TRUE
  ) +
  labs(
    title = "Education Distribution",
    x = "Education",
    y = "Frequency"
  ) +
  theme_minimal() +
  theme(
    axis.text.x = element_text(
      angle = 45,
      hjust = 1
    ),
    legend.position = "none"
  )

3.3 8.3.3 Median Household Income

Tính giá trị trung vị của HHIncomeMid theo trình độ học vấn Education.

medianIncome <- aggregate(
  HHIncomeMid ~ Education,
  data = df2,
  FUN = median,
  na.rm = TRUE
)

medianIncome
##        Education HHIncomeMid
## 1      8th Grade       22500
## 2 9 - 11th Grade       30000
## 3    High School       40000
## 4   Some College       50000
## 5   College Grad       87500

Vẽ biểu đồ cột cho giá trị trung vị thu nhập theo trình độ học vấn.

ggplot(
  medianIncome,
  aes(
    x = Education,
    y = HHIncomeMid,
    fill = Education
  )
) +
  geom_col() +
  geom_text(
    aes(label = round(HHIncomeMid, 0)),
    vjust = -0.3
  ) +
  labs(
    title = "Median Household Income by Education",
    x = "Education",
    y = "Median Household Income"
  ) +
  theme_minimal() +
  theme(
    axis.text.x = element_text(
      angle = 45,
      hjust = 1
    ),
    legend.position = "none"
  )

3.4 8.3.4 Mean BMI by Race1

Tính giá trị BMI trung bình theo từng nhóm Race1.

meanBMI <- aggregate(
  BMI ~ Race1,
  data = df2,
  FUN = mean,
  na.rm = TRUE
)

meanBMI
##      Race1      BMI
## 1    Black 28.10236
## 2 Hispanic 26.37340
## 3  Mexican 26.50243
## 4    White 26.72215
## 5    Other 24.43267

Vẽ biểu đồ cột thể hiện BMI trung bình của từng nhóm.

ggplot(
  meanBMI,
  aes(
    x = Race1,
    y = BMI,
    fill = Race1
  )
) +
  geom_col() +
  geom_text(
    aes(label = round(BMI, 2)),
    vjust = -0.3
  ) +
  labs(
    title = "Mean BMI by Race",
    x = "Race",
    y = "Mean BMI"
  ) +
  theme_minimal() +
  theme(
    legend.position = "none"
  )

3.5 8.3.5 Boxplot HHIncomeMid theo Race1

Vẽ boxplot mô tả phân bố thu nhập hộ gia đình theo từng nhóm Race1, với màu khác nhau cho từng nhóm.

ggplot(
  df2,
  aes(
    x = Race1,
    y = HHIncomeMid,
    fill = Race1
  )
) +
  geom_boxplot(
    na.rm = TRUE
  ) +
  labs(
    title = "Household Income by Race",
    x = "Race",
    y = "Household Income"
  ) +
  theme_minimal() +
  theme(
    legend.position = "none"
  )

3.6 8.3.6 Age và BMI theo Race1

Vẽ scatterplot thể hiện mối liên hệ giữa Age và BMI.

Đường LOESS được sử dụng để mô tả xu hướng mối liên hệ giữa Age và BMI. Biểu đồ được tách riêng theo từng nhóm Race1.

ggplot(
  df2,
  aes(
    x = Age,
    y = BMI,
    color = Race1
  )
) +
  geom_point(
    alpha = 0.4,
    na.rm = TRUE
  ) +
  geom_smooth(
    method = "loess",
    se = TRUE,
    na.rm = TRUE
  ) +
  facet_wrap(~ Race1) +
  labs(
    title = "Relationship between Age and BMI by Race",
    x = "Age",
    y = "BMI"
  ) +
  theme_minimal() +
  theme(
    legend.position = "none"
  )

3.7 8.3.6 Bonus - 3D Scatterplot

Biểu đồ scatterplot 3D sử dụng:

  • Trục X: Age
  • Trục Y: BMI
  • Trục Z: Poverty
  • Màu sắc: Race1
df2_3d <- subset(
  df2,
  !is.na(Age) &
  !is.na(BMI) &
  !is.na(Poverty) &
  !is.na(Race1)
)

fig <- plot_ly(
  data = df2_3d,
  x = ~Age,
  y = ~BMI,
  z = ~Poverty,
  color = ~Race1,
  type = "scatter3d",
  mode = "markers",
  marker = list(
    size = 3,
    opacity = 0.7
  )
)

fig <- layout(
  fig,
  title = "3D Relationship between Age, BMI and Poverty by Race",
  scene = list(
    xaxis = list(title = "Age"),
    yaxis = list(title = "BMI"),
    zaxis = list(title = "Poverty")
  )
)

fig

4 Kết luận

Qua các biểu đồ trên, dữ liệu NHANES có thể được sử dụng để trực quan hóa và khảo sát nhiều đặc điểm liên quan đến nhân khẩu học, thu nhập và sức khỏe.

Các kỹ thuật đã sử dụng bao gồm: