bonedata
pthao
2025-06-27
#——–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”
file.choose()## [1] "D:\\HOC TAP\\TAP HUAN UNG DUNG AI TRONG PT DU LIEU SU DUNG R\\THUC HANH TAI LOP\\hocR1_5\\bone.Rmd"df1=read.csv("D:\\HOC TAP\\TAP HUAN UNG DUNG AI TRONG PT DU LIEU SU DUNG R\\thuc hanh\\Bone data.csv")
head(df1)## 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 0dim(df1)## [1] 2162 9#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? #vẽ biểu đồ dùng lessR
library(lessR)## Warning: package 'lessR' was built under R version 4.4.3##
## 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 object is masked from 'package:base':
##
## sort_by# Chuyển đổi cột fnbmd sang dạng numeric (nếu chưa đúng)
df1$fnbmd <- as.numeric(df1$fnbmd)
# Bước 4: Gán cột fnbmd thành một biến riêng
Y <- df1$fnbmd
# Bước 5: Vẽ biểu đồ histogram bằng lessR
Histogram(Y,
main = "Phân bố mật độ xương tại cổ xương đùi",
xlab = "Mật độ xương (fnbmd)",
fill = "lightblue",
density_fill = TRUE,
show.norm = TRUE)## >>> Note: Y is not in a data frame (table)
## >>> Note: Y is not in a data frame (table)
## >>> Suggestions
## bin_width: set the width of each bin
## bin_start: set the start of the first bin
## bin_end: set the end of the last bin
## Histogram(Y, density=TRUE) # smoothed curve + histogram
## Plot(Y) # Violin/Box/Scatterplot (VBS) plot
##
## --- Y ---
##
## n miss mean sd min mdn max
## 2122 40 0.829 0.155 0.280 0.820 1.510
##
##
##
## --- Outliers --- from the box plot: 33
##
## Small Large
## ----- -----
## 0.3 1.5
## 0.3 1.5
## 0.4 1.4
## 0.4 1.4
## 0.4 1.4
## 0.4 1.4
## 0.4 1.4
## 0.4 1.4
## 0.4 1.3
## 0.4 1.3
## 0.4 1.3
## 1.3
## 1.3
## 1.3
## 1.3
## 1.2
## 1.2
## 1.2
##
## + 15 more outliers
##
##
## Bin Width: 0.1
## Number of Bins: 14
##
## Bin Midpnt Count Prop Cumul.c Cumul.p
## ---------------------------------------------------
## 0.2 > 0.3 0.25 1 0.00 1 0.00
## 0.3 > 0.4 0.35 9 0.00 10 0.00
## 0.4 > 0.5 0.45 15 0.01 25 0.01
## 0.5 > 0.6 0.55 103 0.05 128 0.06
## 0.6 > 0.7 0.65 306 0.14 434 0.20
## 0.7 > 0.8 0.75 522 0.24 956 0.44
## 0.8 > 0.9 0.85 534 0.25 1490 0.69
## 0.9 > 1.0 0.95 371 0.17 1861 0.86
## 1.0 > 1.1 1.05 183 0.08 2044 0.95
## 1.1 > 1.2 1.15 48 0.02 2092 0.97
## 1.2 > 1.3 1.25 21 0.01 2113 0.98
## 1.3 > 1.4 1.35 6 0.00 2119 0.98
## 1.4 > 1.5 1.45 2 0.00 2121 0.98
## 1.5 > 1.6 1.55 1 0.00 2122 0.98
## Histogram(fnbmd,
data = df1,
fill = "blue",
xlab = "Mật độ xương ở cổ xương đùi (g/cm2)",
ylab = "Số người",
main = "Phân bố mật độ xương")
## >>> Suggestions
## bin_width: set the width of each bin
## bin_start: set the start of the first bin
## bin_end: set the end of the last bin
## Histogram(fnbmd, density=TRUE) # smoothed curve + histogram
## Plot(fnbmd) # Violin/Box/Scatterplot (VBS) plot
##
## --- fnbmd ---
##
## n miss mean sd min mdn max
## 2122 40 0.829 0.155 0.280 0.820 1.510
##
##
##
## --- Outliers --- from the box plot: 33
##
## Small Large
## ----- -----
## 0.3 1.5
## 0.3 1.5
## 0.4 1.4
## 0.4 1.4
## 0.4 1.4
## 0.4 1.4
## 0.4 1.4
## 0.4 1.4
## 0.4 1.3
## 0.4 1.3
## 0.4 1.3
## 1.3
## 1.3
## 1.3
## 1.3
## 1.2
## 1.2
## 1.2
##
## + 15 more outliers
##
##
## Bin Width: 0.1
## Number of Bins: 14
##
## Bin Midpnt Count Prop Cumul.c Cumul.p
## ---------------------------------------------------
## 0.2 > 0.3 0.25 1 0.00 1 0.00
## 0.3 > 0.4 0.35 9 0.00 10 0.00
## 0.4 > 0.5 0.45 15 0.01 25 0.01
## 0.5 > 0.6 0.55 103 0.05 128 0.06
## 0.6 > 0.7 0.65 306 0.14 434 0.20
## 0.7 > 0.8 0.75 522 0.24 956 0.44
## 0.8 > 0.9 0.85 534 0.25 1490 0.69
## 0.9 > 1.0 0.95 371 0.17 1861 0.86
## 1.0 > 1.1 1.05 183 0.08 2044 0.95
## 1.1 > 1.2 1.15 48 0.02 2092 0.97
## 1.2 > 1.3 1.25 21 0.01 2113 0.98
## 1.3 > 1.4 1.35 6 0.00 2119 0.98
## 1.4 > 1.5 1.45 2 0.00 2121 0.98
## 1.5 > 1.6 1.55 1 0.00 2122 0.98
## #6.3 So sánh mật độ cổ xương đùi giữa nam và nữ #PROMPT: Dùng gói lệnh ‘lessR’ so sánh mật độ xương giữa nam và nữ (sex)
# Chuyển sex thành factor (nam/nữ)
df1$sex <- factor(df1$sex, levels = c("Male", "Female"))
# Kiểm định t-test so sánh mật độ xương giữa nam và nữ
ttest(fnbmd ~ sex, data = df1)##
## 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
#Việc 7. Đánh giá ảnh hưởng của cafe lên RER bằng phương pháp bootstrap
#PROMPT 1: Tôi có dữ liệu của 18 người trong 2 nhóm như sau: placebo =
105, 119, 100, 97, 96, 101, 94, 95, 98 và coffee = 96, 99, 94, 89, 96,
93, 88, 105, 88. Bạn giúp viết lệnh R để phân tích sự khác biệt giữa 2
nhóm bằng phương pháp bootstrap
# Bước 1: nhập dữ liệu
placebo <- c(105, 119, 100, 97, 96, 101, 94, 95, 98)
coffee <- c(96, 99, 94, 89, 96, 93, 88, 105, 88)
# Bước 2: định nghĩa hàm bootstrap
set.seed(123) # Đặt seed để kết quả lặp lại được
n_boot <- 10000
boot_diff <- numeric(n_boot)
for (i in 1:n_boot) {
sample_placebo <- sample(placebo, replace = TRUE)
sample_coffee <- sample(coffee, replace = TRUE)
boot_diff[i] <- mean(sample_placebo) - mean(sample_coffee)
}
# Bước 3: tóm tắt và hiển thị kết quả
## Trung bình chênh lệch bootstrap
mean(boot_diff)## [1] 6.333167## Khoảng tin cậy 95%
quantile(boot_diff, c(0.025, 0.975))## 2.5% 97.5%
## 0.8888889 12.4444444## Vẽ histogram của chênh lệch trung bình
hist(boot_diff,
main = "Phân bố bootstrap của chênh lệch trung bình (Placebo - Coffee)",
xlab = "Chênh lệch trung bình",
col = "lightblue", border = "white")
abline(v = quantile(boot_diff, c(0.025, 0.975)), col = "red", lty = 2)
abline(v = mean(boot_diff), col = "blue", lwd = 2)
#So sánh 2 nhóm - biến phân loại #Việc 8. So sánh tỉ lệ gãy xương giữa
nam và nữ
# Tạo bảng tần số
table_fx_sex <- table(df1$sex, df1$fx)
table_fx_sex##
## 0 1
## Male 701 144
## Female 916 401# Thực hiện chi-square test
chisq.test(table_fx_sex)##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: table_fx_sex
## X-squared = 48.363, df = 1, p-value = 0.000000000003542