Bài tập về nhà
Phúc Ân
2023-06-04
1 Bài tập tuần 4
Ta sẽ gọi các pakage làm việc cần thiết cho việc trực quan hóa dữ liệu.Sau đó gán dữ liệu có tên a
library(tidyverse)
library(DT)
library(AER)
library(ggplot2)
library(scales)
library(utf8)data("Medicaid1986")
medi <- Medicaid1986
datatable(medi,options = list(scrollX = TRUE))Tiếp theo ta gán tên các biến 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(medi) <- c("vi","ex","ch","ag","in","he1","he2","ac","ma","ge","et","sc","en","pr")
medi$tage <- cut(medi$ag,breaks=c(15,30,60,110),labels=c('trẻ tuổi','trung niên','cao tuổi'))
datatable(medi,options = list(scrollX = TRUE, pageLength = 5))1.1 Scatter plot
Ta sẽ vẽ đồ thị phân có đường hồi quy để thể hiện mối tương quan giữa hai biến số lần bác sĩ đến khám và số tuổi của bệnh nhân
medi %>% ggplot(aes(x = vi, y = ag )) +
geom_point(color="purple") +
geom_smooth(formula = y ~ x, method = "lm", color= "red") +
xlab("Tuổi bệnh nhân") +
ylab("Số lần bác sĩ đến khám") +
ggtitle("ĐỒ THỊ SỐ LẦN BÁC SĨ ĐẾN KHÁM VÀ SỐ TUỔI BỆNH NHÂN")
cor(medi$vi,medi$ag)## [1] 0.09516099Nhận xét: Qua đồ thị ta thấy rằng số tuổi càng tăng thì số lần bác sĩ tới khám tăng theo. Tuy nhiên hệ số tương quan rất thấp (0.0952) nên các điểm tập trung dày đặt ở đầu hồi quy ## Biểu đồ cột
Biểu đồ đếm tỉ lệ của các nhóm tuổi
table(medi$tage)##
## trẻ tuổi trung niên cao tuổi
## 270 214 512medi |> group_by(tage) |>
summarise(n = n()) |>
mutate(pG = percent(n/sum(n), accuracy = ,01)) |>
ggplot(aes(x = tage, y = pG)) +
geom_col(fill = 'lightblue') +
theme_classic() +
labs(x = 'Nhóm tuổi', y = 'Tỷ lệ %')
Qua biểu đồ ta thấy rằng số lượng người cao tuổi chiếm tỉ lệ nhiều nhất
1.2 Biểu đồ tròn
medi_summary <- medi %>%
group_by(tage) %>%
summarise(n = n()) %>%
mutate(percentage = n/sum(n))
ggplot(medi_summary, aes(x = "", y = percentage, fill = tage)) +
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("blue", "red", "green"), name = "Nhóm tuổi") +
labs(title = "BIỂU ĐỒ PHÂN BỐ NHÓM TUỔI") +
theme_minimal() +
theme(legend.position = "bottom")
2 Bài tập tuần 3
Package: Ecdat - dataset: Budget food.
GIẢI THÍCH Dữ liệu: Dữ liệu BudgetFood là dữ liệu về việc chi tiêu ngân sách cho đồ ăn của các gia đình tây ban nha. Dữ liệu bao gồm 23972 quan sát và 6 biến.
wfood: tỉ lệ phần trăm mà gia đình chi tiêu cho thức ăn trong tổng chi tiêu gia đình
totalexp: tổng chi tiêu gia đình
age: tuổi
size: số người trong gia đình
town: quy mô thị trấn mà gia đình ở được chia thành 5 nhóm (từ 1: thị trấn nhỏ đến 5: thị trấn lớn)
sex: giới tính
2.1 Lệnh pivot_wider
Ta thực hiện việc gọi các package cần thiết cho việc phân tích như tidyverse, DT, Ecdat và gọi dataset BudgetFood. Sau đó gán dataset vào biến bf
library(tidyverse)
library(DT)
library(Ecdat)
data(BudgetFood)
bf <- BudgetFood
datatable(bf)2.1.1 Tổng hợp tỉ lệ chi tiêu đồ ăn, tuổi, số lượng thành viên trong gia đình
- Ta sử dung lệnh pivot_wider để chuyển đổi dữ liệu dựa trên tuổi với các giá trị “wfood”, “totalexp”, “size” trong “bf”
Bảng tổng hơp tỉ lệ chi tiêu thức ăn của từng độ tuổi theo giới tính
food <- bf %>% select(sex,age,wfood,town)%>%pivot_wider(names_from = age,values_from = wfood) %>% arrange(town) ## Warning: Values from `wfood` are not uniquely identified; output will contain list-cols.
## • Use `values_fn = list` to suppress this warning.
## • Use `values_fn = {summary_fun}` to summarise duplicates.
## • Use the following dplyr code to identify duplicates.
## {data} %>%
## dplyr::group_by(sex, town, age) %>%
## dplyr::summarise(n = dplyr::n(), .groups = "drop") %>%
## dplyr::filter(n > 1L)datatable(food, options= list(scollX= TRUE, pagelength=5))Bảng tổng hợp tổng chi tiêu của từng độ tuổi theo giới tính
expa <- bf %>% select(sex,age,totexp,town)%>%pivot_wider(names_from = age,values_from = totexp) %>% arrange(town) ## Warning: Values from `totexp` are not uniquely identified; output will contain
## list-cols.
## • Use `values_fn = list` to suppress this warning.
## • Use `values_fn = {summary_fun}` to summarise duplicates.
## • Use the following dplyr code to identify duplicates.
## {data} %>%
## dplyr::group_by(sex, town, age) %>%
## dplyr::summarise(n = dplyr::n(), .groups = "drop") %>%
## dplyr::filter(n > 1L)datatable(expa, options= list(scollX= TRUE, pagelength=5))Bảng tổng hợp số lượng thành viên gia đình của từng độ tuổi theo giới tính
siz <- bf %>% select(sex,age,size,town)%>%pivot_wider(names_from = age,values_from = size) %>% arrange(town) ## Warning: Values from `size` are not uniquely identified; output will contain list-cols.
## • Use `values_fn = list` to suppress this warning.
## • Use `values_fn = {summary_fun}` to summarise duplicates.
## • Use the following dplyr code to identify duplicates.
## {data} %>%
## dplyr::group_by(sex, town, age) %>%
## dplyr::summarise(n = dplyr::n(), .groups = "drop") %>%
## dplyr::filter(n > 1L)datatable(siz, options= list(scollX= TRUE, pagelength=5))2.2 Lệnh pivot_longer
ở bước này ta chuyển đổ dữ liệu thành rộng Bảng tổng hơp tỉ lệ chi tiêu thức ăn của từng độ tuổi theo giới tính
food1 <- food%>% pivot_longer(cols= names(food)[-c(1, 2)], names_to = "age",values_to = "wfood")
datatable(food1)Bảng tổng hợp tổng chi tiêu của từng độ tuổi theo giới tính
expa1 <- expa%>% pivot_longer(cols= names(expa)[-c(1, 2)], names_to = "age",values_to = "totexp")
datatable(expa1)Bảng tổng hợp số lượng thành viên gia đình của từng độ tuổi theo giới tính
siz1 <- siz%>% pivot_longer(cols= names(siz)[-c(1, 2)], names_to = "age",values_to = "size")
datatable(siz1)3 Bài tập tuần 2
GIẢI THÍCH Dữ liệu: Dữ liệu lấy từ cuộc khảo sát người được cứu thương. Dữ liệu bao gồm những người được cứu thương ở quận Santa Barbara và Ventura của bang California. Dữ liệu chứa 996 quan sát và chứa 14 biến:
visits: Số bác sĩ đến Khám
exposure: Thời gian quan sát đối với dịch vụ chăm sóc ngoại trú.
children: số đứ trẻ có trong gia đình
age: số tuổi.
income Annual household: thu nhập thường niên trong gia đình.
health1: Thành phần chính đầu tiên của ba biến tình trạng sức khỏe: chức năng hạn chế, tình trạng cấp tính và tình trạng mãn tính.
health2: Thành phần chính thứ 2 của ba biến tình trạng sức khỏe: chức năng hạn chế, tình trạng cấp tính và tình trạng mãn tính.
access: Sự sẵn có của các dịch vụ y tế (0 = khả năng tiếp cận thấp, 1 = khả năng tiếp cận cao). married: có kết hôn hay không
gender: giới tính
ethnicity: dân tộc
school: số năm học ở trường
enroll; có phải cá nhân đăng ký nhập viện
program: chương trình chăm sóc
3.1 Đặt tên cho các biến
Ta lấy dữ liệu Medicaid 1986 từ package AER
Sau đó gán dataset Medicaid 1986 vào a và sử sụng lệnh na.omit để loại bỏ các dữ liệu na.
Sử dụng lệnh names để đặt tên cho 14 biến
Chúng ta lập bảng về tình trạng kết hôn bằng lệnh table và chọn biến married (đặt tên là ma)
Kết quả cho thấy:
Số người chưa kết hôn chiếm cao nhất là 780 người trong tổng số 996 người chiếm khoảng 78%
Số người kết hôn là 216 người chiếm khoảng 22%
##
## no yes
## 780 216##
## no yes
## 78.31325 21.68675- Kế tiếp ta phân độ tuổi bằng lệnh cut. Bảng này cho ta thấy:
- Số người bị thương dưới 18 tuổi chiếm thấp nhấtlà 10 người chiếm 1%
- Số người bị thương khoảng 18 đến 65 tuổi là 481 người chiếm 48%
- Số người bị thương trên 65 tuổi chiếm nhiều nhất khoảng 51%
##
## (-1,18] (18,65] (65,95]
## 10 481 501
##
## (-1,18] (18,65] (65,95]
## 0.01004016 0.48293173 0.503012053.2 Phân tích biến exposure
##
## (0,60] (60,90] (90,150]
## 3 48 945vậy số ngày người bị thương dưới 60 ngày là 3 người thấp nhất chiếm 0,3% số người bị thương ở viện từ 60 đến 90 ngày là 48 người chiếm khoảng 4,8% Số người bị thương ở viện từ 90 ngày trở lên chiếm cao nhất 94,87% với 945 người.
3.3 Phân tích biến child
##
## (-1,3] (3,6] (6,9]
## 902 88 6vậy gia đình có dưới 3 con chiếm nhiều nhất v́ơi 902 người chiếm khoảng 90,56% gia đình có từ 4 đến 6 con chiếm 8,83% với 88 người. gia đình có 7 con trở lên chiếm thấp nhất với 6 người chiếm khoảng 0,6% ##Phân tích biến gender
##
## male female
## 153 843
Nam chiếm ít nhất với 153 người chiếm khoảng 15,35% Nữ chiếm nhiều nhất với 843 người chiếm khoảng 84,65%
Phân tích biến Program
## afdc ssi
## 485 511##
## afdc ssi
## 0.4869478 0.5130522
vâỵ afdc chiếm 48,69% còn ssi chiếm 51,31%
Phân tích biến income
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.500 6.000 7.990 8.191 8.500 17.500Min: thu nhập thấp nhất là 5
Max: thu nhập cao nhất là 17.5
Median: thu nhập trug bình là 8.191
1st Qu.: là tứ phân vị nhất nghĩa là 25% thu nhập dưới 6
3rd Qu.: là tứ phân vị thứ ba nghĩa là 75% thu nhập dưới 8.5
## (-1,6] (6,12] (12,18]
## 465 425 106##
## (-1,6] (6,12] (12,18]
## 0.4668675 0.4267068 0.1064257
3.4 Phân tích biến ethnicity
summary(a$et)## cauc other
## 691 305prop.table(table(a$et))##
## cauc other
## 0.6937751 0.3062249vậy người tây chiếm 69,38%, khác chiếm 30,62%
3.5 Phân tích biến school
## (-1,5] (5,10] (10,15] (15,20]
## 215 305 445 31##
## (-1,5] (5,10] (10,15] (15,20]
## 21.58635 30.62249 44.67871 3.11245
Những người học dưới 5 năm chiếm 21,59%
Những người học từ 6 năm đến 10 năm chiếm 30,62%
Những người học từ 11 năm đến 15 năm chiếm nhiều nhất với 44,68%
Những người học từ 16 năm đến 20 năm chiếm ít nhất với 3,11%
3.6 Phân tích biến enroll
## no yes
## 506 490##
## no yes
## 50.80321 49.19679
Số người tự đăng ký là 49,2%, còn lại là 50,8%
3.7 Phân tích biến health 1
## (-3,0] (0,3] (3,6] (6,9]
## 567 400 28 1##
## (-3,0] (0,3] (3,6] (6,9]
## 0.569277108 0.401606426 0.028112450 0.001004016
Mức độ tổng quát sức khỏe của biến health1 từ khoảng -3 đến 0 chiếm tỉ lệ nhiều nhất khoảng 56.93% với 567 người
Mức độ tổng quát sức khỏe của biến health 1 từ khoảng 0 đến 3 chiếm tỉ lệ khoảng 40,16% với 400 người
Mức độ tổng quát sức khỏe của biến health 1 từ khoảng 3 đến 6 chiếm khoảng 2.81% với 28 người
Mức độ tổng quát sức khỏe của biến health 1 từ khoảng 6 đến 9 chiếm tỉ lệ ít nhất khoảng 0,1% với 1 người
3.8 Phân tích biến heal 2
## (-3,-1] (-1,1] (1,4]
## 74 835 87##
## (-3,-1] (-1,1] (1,4]
## 0.07429719 0.83835341 0.08734940
Mức độ tổng quan sức khỏe của biến health 2 từ khoảng -3 đ́ến -1 chiếm tỉ lệ ít nhất với 74 người chiếm khoảng 7,43%
Mức độ tổng quát sức khỏe của biến health 2 từ khoảng -1 đến 1 chiếm tỉ lệ nhiều nhất với 835 người chiếm khoảng 83,84%
Mức độ tổng quát sức khỏe của biến health 2 từ khoảng 1 đến 4 chiếm tỉ lệ khoảng 8,73% với 87 người
4 Bài tập tuần 1
GIẢI THÍCH Dữ liệu: Dữ liệu lấy từ cuộc khảo sát người được cứu thương. Dữ liệu bao gồm những người được cứu thương ở quận Santa Barbara và Ventura của bang California. Dữ liệu chứa 996 quan sát và chứa 14 biến:
visits: Số bác sĩ đến Khám
exposure: Thời gian quan sát đối với dịch vụ chăm sóc ngoại trú.
children: số đứ trẻ có trong gia đình
age: số tuổi.
income Annual household: thu nhập thường niên trong gia đình.
health1: Thành phần chính đầu tiên của ba biến tình trạng sức khỏe: chức năng hạn chế, tình trạng cấp tính và tình trạng mãn tính.
health2: Thành phần chính thứ 2 của ba biến tình trạng sức khỏe: chức năng hạn chế, tình trạng cấp tính và tình trạng mãn tính.
access: Sự sẵn có của các dịch vụ y tế (0 = khả năng tiếp cận thấp, 1 = khả năng tiếp cận cao). married: có kết hôn hay không
gender: giới tính
ethnicity: dân tộc
school: số năm học ở trường
enroll; có phải cá nhân đăng ký nhập viện
program: chương trình chăm sóc
4.1 Các thao tác với dữ liệu
Tải và kích hoạt package AER
library(AER)Lấy dữ liệu của Medicaid1986 và gán vào biến a
data("Medicaid1986")
a <- Medicaid1986Mô tả cấu trúc dữ liệu
str(a)## 'data.frame': 996 obs. of 14 variables:
## $ visits : int 0 1 0 0 11 3 0 6 1 0 ...
## $ exposure : int 100 90 106 114 115 102 92 92 117 101 ...
## $ children : int 1 3 4 2 1 1 2 1 1 1 ...
## $ age : int 24 19 17 29 26 22 24 21 21 24 ...
## $ income : num 14.5 6 8.38 6 8.5 ...
## $ health1 : num 0.495 0.52 -1.227 -1.524 0.173 ...
## $ health2 : num -0.854 -0.969 0.317 0.457 -0.599 0.062 0.202 -0.981 0.317 -0.562 ...
## $ access : num 0.5 0.17 0.42 0.33 0.67 0.25 0.5 0.67 0.25 0.67 ...
## $ married : Factor w/ 2 levels "no","yes": 1 1 1 1 1 1 1 2 1 2 ...
## $ gender : Factor w/ 2 levels "male","female": 2 2 2 2 2 2 2 2 2 2 ...
## ..- attr(*, "contrasts")= num [1:2, 1] 1 0
## .. ..- attr(*, "dimnames")=List of 2
## .. .. ..$ : chr [1:2] "male" "female"
## .. .. ..$ : chr "male"
## $ ethnicity: Factor w/ 2 levels "cauc","other": 1 1 1 1 1 2 1 1 1 1 ...
## ..- attr(*, "contrasts")= num [1:2, 1] 1 0
## .. ..- attr(*, "dimnames")=List of 2
## .. .. ..$ : chr [1:2] "caucasian" "other"
## .. .. ..$ : chr "caucasian"
## $ school : int 13 11 12 12 16 12 11 11 12 15 ...
## $ enroll : Factor w/ 2 levels "no","yes": 2 2 2 2 2 2 2 2 2 2 ...
## $ program : Factor w/ 2 levels "afdc","ssi": 1 1 1 1 1 1 1 1 1 1 ...Lấy 3 dòng đầu tiên
## visits exposure children age income health1 health2 access married gender
## 1 0 100 1 24 14.500 0.495 -0.854 0.50 no female
## 2 1 90 3 19 6.000 0.520 -0.969 0.17 no female
## 3 0 106 4 17 8.377 -1.227 0.317 0.42 no female
## ethnicity school enroll program
## 1 cauc 13 yes afdc
## 2 cauc 11 yes afdc
## 3 cauc 12 yes afdcGán tên các biến mới
#Gán tên viết tắt cho các biến thuộc dữ liệu "g" cho tiện thao tác
names(a) <- c("vi","ex","ch","ag","in","he1","he2","ac","ma","ge","et","sc","en","pr")Tóm tắt thống kê biến age
summary(a$ag)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 16.00 29.00 66.00 55.21 78.00 105.00phân tổ biến age và lập bảng tần số biến age
age4 <- cut(a$ag,4)
table(cut(a$ag,4))##
## (15.9,38.2] (38.2,60.5] (60.5,82.8] (82.8,105]
## 398 86 365 147Lập bảng tần số biến age với biến visit
table(cut(a$vi,4),age4)## age4
## (15.9,38.2] (38.2,60.5] (60.5,82.8] (82.8,105]
## (-0.05,12.5] 394 86 361 146
## (12.5,25] 3 0 3 1
## (25,37.5] 0 0 0 0
## (37.5,50] 1 0 1 0Tần suất biến age4
x=table(cut(a$vi,4),age4)
prop.table(x)## age4
## (15.9,38.2] (38.2,60.5] (60.5,82.8] (82.8,105]
## (-0.05,12.5] 0.395582329 0.086345382 0.362449799 0.146586345
## (12.5,25] 0.003012048 0.000000000 0.003012048 0.001004016
## (25,37.5] 0.000000000 0.000000000 0.000000000 0.000000000
## (37.5,50] 0.001004016 0.000000000 0.001004016 0.000000000Lấy các biến có age= 30 và gán vào biến age30
age30 <- a[a$ag==25,]
head(age30)## vi ex ch ag in he1 he2 ac ma ge et sc en pr
## 38 2 106 1 25 8.500 -0.608 -0.078 0.67 no female other 14 yes afdc
## 42 0 103 2 25 6.000 -0.583 -0.193 0.50 no female cauc 6 yes afdc
## 48 0 101 1 25 6.000 0.173 -0.599 0.17 no female cauc 12 yes afdc
## 68 2 101 1 25 6.000 1.251 0.485 0.00 no female other 10 yes afdc
## 133 0 94 1 25 8.377 0.309 -0.612 0.17 no female cauc 13 yes afdc
## 162 10 106 2 25 8.500 2.082 1.479 0.67 no female cauc 15 yes afdcLấy các biến có age>85 và school=10
age85sch10 <- a[a$ag>85&a$sc==10,]số lượng biến và quan sát của biến age85sch10
dim(age85sch10)## [1] 1 14lấy ngẫu nhiên 2 dòng
aa <- a[sample(nrow(a),2),]
aa## vi ex ch ag in he1 he2 ac ma ge et sc en pr
## 145 0 101 2 31 8.5 0.792 -0.994 0.33 no female cauc 10 yes afdc
## 448 0 110 5 22 8.5 -1.363 0.329 0.35 no female cauc 9 no afdcvẽ đồ thị
summary(a$en)## no yes
## 506 490prop.table(table(a$en))*100##
## no yes
## 50.80321 49.19679plot(a$en)