Baitap2
TV
2025-06-17
# Đọc dữ liệu
CH=read.csv("/Users/thaovu/Downloads/CHNS data full.csv")# Mở package
library(ggplot2)
# Vẽ histogram của biến income
ggplot(data = CH, aes(x = income)) +
geom_histogram(binwidth = 500, fill = "steelblue", color = "black", border = "white", alpha = 0.7) +
labs(title = "Phân bố thu nhập (income)",
x = "Thu nhập",
y = "Tần suất") +
theme_minimal()## Warning in geom_histogram(binwidth = 500, fill = "steelblue", color = "black", :
## Ignoring unknown parameters: `border`## Warning: Removed 224 rows containing non-finite outside the scale range
## (`stat_bin()`).
# Sử dụng logg cho income để chuẩn hoá giá trị income nhưng nhược điểm là không diễn giải được đơn vị log
ggplot(data = CH, aes(x = log(income))) +
geom_histogram(binwidth = 0.2, fill = "darkgreen", color = "white", alpha = 0.7) +
labs(title = "Phân bố log(income)",
x = "Log(Thu nhập)",
y = "Tần suất") +
theme_minimal()## Warning: Removed 241 rows containing non-finite outside the scale range
## (`stat_bin()`).
CH$gender_label <- factor(CH$gender, levels = c(1, 2), labels = c("Nam", "Nữ"))
# Vẽ histogram log(income) phân theo giới tính
ggplot(CH[CH$income > 0, ], aes(x = log(income), fill = gender_label)) +
geom_histogram(position = "identity", alpha = 0.4, binwidth = 0.2, color = "black") +
scale_fill_manual(values = c("blue", "red")) +
labs(title = "Phân bố log(Thu nhập) theo Giới tính",
x = "Log(Thu nhập)",
y = "Tần suất",
fill = "Giới tính") +
theme_minimal()## Warning: Removed 224 rows containing non-finite outside the scale range
## (`stat_bin()`).
# Dữ liệu có income > 0
data_plot <- CH[CH$income > 0, ]
# Tạo nhãn giới tính
data_plot$gender_label <- factor(data_plot$gender, levels = c(1, 2), labels = c("Nam", "Nữ"))
# Vẽ hai histogram tách biệt
ggplot() +
geom_histogram(data = subset(data_plot, gender_label == "Nam"),
aes(x = log(income)),
fill = "blue", alpha = 0.5, binwidth = 0.2, color = "black") +
geom_histogram(data = subset(data_plot, gender_label == "Nữ"),
aes(x = log(income)),
fill = "pink", alpha = 0.25, binwidth = 0.2, color = "black") +
labs(title = "Phân bố log(Thu nhập) theo Giới tính",
x = "Log(Thu nhập)",
y = "Tần suất") +
theme_minimal() +
theme(legend.position = "none")
# Vẽ density + đường nối
ggplot(data_plot, aes(x = log(income), color = gender_label, fill = gender_label)) +
geom_density(alpha = 0.3) + # Vùng màu trong suốt
geom_line(stat = "density", size = 1.2) + # Đường nối
scale_color_manual(values = c("blue", "deeppink")) +
scale_fill_manual(values = c("lightblue", "pink")) +
labs(title = "Mật độ phân bố log(Thu nhập) theo Giới tính",
x = "Log(Thu nhập)",
y = "Mật độ",
color = "Giới tính",
fill = "Giới tính") +
theme_minimal()## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## Warning: Removed 224 rows containing non-finite outside the scale range
## (`stat_density()`).
## Removed 224 rows containing non-finite outside the scale range
## (`stat_density()`).
# Gắn nhãn trình độ học vấn
CH$edu_label <- factor(CH$edu,
levels = c(1, 2, 3),
labels = c("Tiểu học", "THCS–THPT", "Đại học trở lên"))
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union# Tính median
income_median <- CH %>%
group_by(edu_label) %>%
summarise(median_income = median(income, na.rm = TRUE))
ggplot(income_median, aes(x = edu_label, y = median_income, fill = edu_label)) +
geom_col(width = 0.6) +
scale_fill_manual(values = c("skyblue", "orange", "forestgreen")) +
labs(title = "Thu nhập trung vị theo trình độ học vấn",
x = "Trình độ học vấn",
y = "Thu nhập trung vị") +
theme_minimal() +
theme(legend.position = "none") +
geom_text(aes(label = round(median_income, 0)),
vjust = -0.5,
size = 4,
fontface = "bold")
ggplot(CH, aes(x = edu_label, y = income, fill = edu_label)) +
geom_boxplot(alpha = 0.7, outlier.color = "red", outlier.shape = 1) +
scale_fill_manual(values = c("skyblue", "orange", "forestgreen")) +
labs(title = "Thu nhập theo trình độ học vấn",
x = "Trình độ học vấn",
y = "Thu nhập") +
theme_minimal() +
theme(legend.position = "none")## Warning: Removed 224 rows containing non-finite outside the scale range
## (`stat_boxplot()`).
#Việc 4: Soạn biểu đồ hộp so sánh phân bố của thu nhập (income) theo giới tính
ggplot(data_plot, aes(x = gender_label, y = log(income), fill = gender_label)) +
geom_boxplot() +
geom_jitter(alpha = 0.02)+
labs(title = "Thu nhậptheo giới tính",
x = "Giới tính",
y = "Thu nhập") +
theme_minimal() +
theme(legend.position = "none")## Warning: Removed 224 rows containing non-finite outside the scale range
## (`stat_boxplot()`).## Warning: Removed 224 rows containing missing values or values outside the scale range
## (`geom_point()`).
ggplot(data_plot, aes(x = age, y = log(income))) +
geom_point(alpha = 0.5, color = "steelblue") + # các điểm dữ liệu
geom_smooth(method = "lm", se = TRUE, color = "darkred", size = 1) + # đường hồi quy tuyến tính
labs(title = "Tương quan giữa Tuổi và Log(Thu nhập)",
x = "Tuổi",
y = "Log(Thu nhập)") +
theme_minimal()## `geom_smooth()` using formula = 'y ~ x'## Warning: Removed 226 rows containing non-finite outside the scale range
## (`stat_smooth()`).## Warning: Removed 226 rows containing missing values or values outside the scale range
## (`geom_point()`).
ggplot(data_plot, aes(x = age, y = log(income))) +
geom_point(alpha = 0.5, color = "steelblue") + # Scatter plot
geom_smooth(method = "loess", se = TRUE, color = "darkgreen", size = 1.2) + # Đường hồi quy LOESS
labs(title = "Quan hệ phi tuyến giữa Tuổi và Log(Thu nhập) (LOESS)",
x = "Tuổi",
y = "Log(Thu nhập)") +
theme_minimal()## `geom_smooth()` using formula = 'y ~ x'## Warning: Removed 226 rows containing non-finite outside the scale range
## (`stat_smooth()`).
## Removed 226 rows containing missing values or values outside the scale range
## (`geom_point()`).
ggplot(data_plot, aes(x = age, y = log(income), color = gender_label)) +
geom_point(alpha = 0.4) +
geom_smooth(method = "loess", se = TRUE, size = 1.5) +
scale_color_manual(values = c("blue", "firebrick")) +
labs(title = "Tương quan giữa Tuổi và Log(Thu nhập) theo Giới tính",
x = "Tuổi",
y = "Log(Thu nhập)",
color = "Giới tính") +
theme_minimal(base_size=14)## `geom_smooth()` using formula = 'y ~ x'## Warning: Removed 226 rows containing non-finite outside the scale range
## (`stat_smooth()`).## Warning: Removed 226 rows containing missing values or values outside the scale range
## (`geom_point()`).
# So sánh 2 nhóm – biến liên tục
## Việc 6. So sánh mật độ xương tại cổ xương đùi giữa nam và nữ
### 6.1 Đọc dữ liệu "Bone data.csv" vào R và gọi dữ liệu là “df”
bn= read.csv("/Users/thaovu/Downloads/Bone data.csv")
head(bn)## id sex age weight height prior.fx fnbmd smoking fx
## 1 1 Male 73 98 175 0 1.08 1 0
## 2 2 Female 68 72 166 0 0.97 0 0
## 3 3 Male 68 87 184 0 1.01 0 0
## 4 4 Female 62 72 173 0 0.84 1 0
## 5 5 Male 61 72 173 0 0.81 1 0
## 6 6 Female 76 57 156 0 0.74 0 0### mở library
library(lessR)##
## lessR 4.4.3 feedback: gerbing@pdx.edu
## --------------------------------------------------------------
## > d <- Read("") Read data file, many formats available, e.g., Excel
## d is default data frame, data= in analysis routines optional
##
## Many examples of reading, writing, and manipulating data,
## graphics, testing means and proportions, regression, factor analysis,
## customization, forecasting, and aggregation from pivot tables
## Enter: browseVignettes("lessR")
##
## View lessR updates, now including time series forecasting
## Enter: news(package="lessR")
##
## Interactive data analysis
## Enter: interact()##
## Attaching package: 'lessR'## The following objects are masked from 'package:dplyr':
##
## order_by, recode, rename### 6.2 Vẽ biểu đồ histogram đánh giá phân bố mật độ xương tại cổ xương đùi. Bạn đánh giá phân bố mật độ xương như thế nào?
head(bn)## id sex age weight height prior.fx fnbmd smoking fx
## 1 1 Male 73 98 175 0 1.08 1 0
## 2 2 Female 68 72 166 0 0.97 0 0
## 3 3 Male 68 87 184 0 1.01 0 0
## 4 4 Female 62 72 173 0 0.84 1 0
## 5 5 Male 61 72 173 0 0.81 1 0
## 6 6 Female 76 57 156 0 0.74 0 0### 6.3 So sánh mật độ cổ xương đùi giữa nam và nữ
ttest(fnbmd~sex,data=bn)##
## Compare fnbmd across sex with levels Male and Female
## Grouping Variable: sex
## Response Variable: fnbmd
##
##
## ------ Describe ------
##
## fnbmd for sex Male: n.miss = 23, n = 822, mean = 0.910, sd = 0.153
## fnbmd for sex Female: n.miss = 17, n = 1300, mean = 0.778, sd = 0.132
##
## Mean Difference of fnbmd: 0.132
##
## Weighted Average Standard Deviation: 0.141
##
##
## ------ Assumptions ------
##
## Note: These hypothesis tests can perform poorly, and the
## t-test is typically robust to violations of assumptions.
## Use as heuristic guides instead of interpreting literally.
##
## Null hypothesis, for each group, is a normal distribution of fnbmd.
## Group Male: Sample mean assumed normal because n > 30, so no test needed.
## Group Female: Sample mean assumed normal because n > 30, so no test needed.
##
## Null hypothesis is equal variances of fnbmd, homogeneous.
## Variance Ratio test: F = 0.023/0.018 = 1.336, df = 821;1299, p-value = 0.000
## Levene's test, Brown-Forsythe: t = 3.449, df = 2120, p-value = 0.001
##
##
## ------ Infer ------
##
## --- Assume equal population variances of fnbmd for each sex
##
## t-cutoff for 95% range of variation: tcut = 1.961
## Standard Error of Mean Difference: SE = 0.006
##
## Hypothesis Test of 0 Mean Diff: t-value = 21.080, df = 2120, p-value = 0.000
##
## Margin of Error for 95% Confidence Level: 0.012
## 95% Confidence Interval for Mean Difference: 0.120 to 0.144
##
##
## --- Do not assume equal population variances of fnbmd for each sex
##
## t-cutoff: tcut = 1.961
## Standard Error of Mean Difference: SE = 0.006
##
## Hypothesis Test of 0 Mean Diff: t = 20.407, df = 1560.981, p-value = 0.000
##
## Margin of Error for 95% Confidence Level: 0.013
## 95% Confidence Interval for Mean Difference: 0.119 to 0.145
##
##
## ------ Effect Size ------
##
## --- Assume equal population variances of fnbmd for each sex
##
## Standardized Mean Difference of fnbmd, Cohen's d: 0.939
##
##
## ------ Practical Importance ------
##
## Minimum Mean Difference of practical importance: mmd
## Minimum Standardized Mean Difference of practical importance: msmd
## Neither value specified, so no analysis
##
##
## ------ Graphics Smoothing Parameter ------
##
## Density bandwidth for sex Male: 0.044
## Density bandwidth for sex Female: 0.034
head(bn)## id sex age weight height prior.fx fnbmd smoking fx
## 1 1 Male 73 98 175 0 1.08 1 0
## 2 2 Female 68 72 166 0 0.97 0 0
## 3 3 Male 68 87 184 0 1.01 0 0
## 4 4 Female 62 72 173 0 0.84 1 0
## 5 5 Male 61 72 173 0 0.81 1 0
## 6 6 Female 76 57 156 0 0.74 0 0R Markdown
This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see http://rmarkdown.rstudio.com.
When you click the Knit button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this:
summary(cars)## speed dist
## Min. : 4.0 Min. : 2.00
## 1st Qu.:12.0 1st Qu.: 26.00
## Median :15.0 Median : 36.00
## Mean :15.4 Mean : 42.98
## 3rd Qu.:19.0 3rd Qu.: 56.00
## Max. :25.0 Max. :120.00Including Plots
You can also embed plots, for example:
Note that the echo = FALSE parameter was added to the
code chunk to prevent printing of the R code that generated the
plot.