PTDLDT
TRẦN DƯƠNG THẢO DÂN
2023-07-14
TUẦN 1
Bộ dữ liệu này cung cấp thông tin toàn diện để dự đoán giá nhà.
Dữ liệu nghiên cứu bao gồm 545 quan sát với 13 biến bao gồm 6 biến định lượng và 7 biến định tính.
Trong đó:
Price : Giá của ngôi nhà.
Area : Tổng diện tích của ngôi nhà tính bằng mét vuông.
Bedrooms : Số phòng ngủ trong nhà.
Bathrooms : Số lượng phòng tắm trong nhà.
Stories : Số lượng truyện trong nhà.
Mainroad : Ngôi nhà có kết nối với đường chính hay không (Yes/No).
Guestroom : Nhà có phòng cho khách không (Yes/No).
Basement : Nhà có tầng hầm hay không (Yes/No).
HWH : Nhà có hệ thống đun nước nóng hay không (Yes/No).
Airconditioning : Nhà có hệ thống điều hòa nhiệt độ hay không (Yes/No).
Parking : Số lượng chỗ đậu xe có sẵn trong nhà.
Prefarea : Ngôi nhà có nằm trong khu vực ưa thích hay không (Yes/No).
FS : Tình trạng nội thất của căn nhà (Đầy đủ nội thất, Bán nội thất, Không nội thất).
library(readxl)## Warning: package 'readxl' was built under R version 4.3.1library(DescTools)## Warning: package 'DescTools' was built under R version 4.3.1library(ggplot2)## Warning: package 'ggplot2' was built under R version 4.3.1library(epitools)
data <- read_excel("C:/Users/PC/Downloads/Housing_TDTD.xls")## New names:
## • `` -> `...14`
## • `` -> `...15`str(data)## tibble [545 × 15] (S3: tbl_df/tbl/data.frame)
## $ Price : num [1:545] 13300000 12250000 12250000 12215000 11410000 ...
## $ Area : num [1:545] 7420 8960 9960 7500 7420 7500 8580 16200 8100 5750 ...
## $ Bedrooms : num [1:545] 4 4 3 4 4 3 4 5 4 3 ...
## $ Bathrooms : num [1:545] 2 4 2 2 1 3 3 3 1 2 ...
## $ Stories : num [1:545] 3 4 2 2 2 1 4 2 2 4 ...
## $ Mainroad : chr [1:545] "yes" "yes" "yes" "yes" ...
## $ Guestroom : chr [1:545] "no" "no" "no" "no" ...
## $ Basement : chr [1:545] "no" "no" "yes" "yes" ...
## $ HWH : chr [1:545] "no" "no" "no" "no" ...
## $ Airconditioning: chr [1:545] "yes" "yes" "no" "yes" ...
## $ Parking : num [1:545] 2 3 2 3 2 2 2 0 2 1 ...
## $ Prefarea : chr [1:545] "yes" "no" "yes" "yes" ...
## $ FS : chr [1:545] "furnished" "furnished" "semi-furnished" "furnished" ...
## $ ...14 : logi [1:545] NA NA NA NA NA NA ...
## $ ...15 : num [1:545] 1650 4400 NA NA NA NA NA NA NA NA ...TUẦN 2
library(readxl)
data<-read_excel("C:/Users/PC/Downloads/Housing_TDTD.xls")## New names:
## • `` -> `...14`
## • `` -> `...15`data## # A tibble: 545 × 15
## Price Area Bedrooms Bathrooms Stories Mainroad Guestroom Basement HWH
## <dbl> <dbl> <dbl> <dbl> <dbl> <chr> <chr> <chr> <chr>
## 1 13300000 7420 4 2 3 yes no no no
## 2 12250000 8960 4 4 4 yes no no no
## 3 12250000 9960 3 2 2 yes no yes no
## 4 12215000 7500 4 2 2 yes no yes no
## 5 11410000 7420 4 1 2 yes yes yes no
## 6 10850000 7500 3 3 1 yes no yes no
## 7 10150000 8580 4 3 4 yes no no no
## 8 10150000 16200 5 3 2 yes no no no
## 9 9870000 8100 4 1 2 yes yes yes no
## 10 9800000 5750 3 2 4 yes yes no no
## # ℹ 535 more rows
## # ℹ 6 more variables: Airconditioning <chr>, Parking <dbl>, Prefarea <chr>,
## # FS <chr>, ...14 <lgl>, ...15 <dbl>Chon biến định tính: tình trạng nội thất của căn nhà (FS)
Chọn biến định lượng: tổng diện tích ngôi nhà (Area)
age.in <- table(data$Area,data$FS)
age.in##
## furnished semi-furnished unfurnished
## 1650 0 0 1
## 1700 0 0 1
## 1836 0 1 0
## 1905 0 1 0
## 1950 0 0 2
## 2000 0 1 0
## 2015 0 1 0
## 2135 0 0 1
## 2145 4 0 2
## 2160 0 1 0
## 2175 0 0 1
## 2176 0 1 0
## 2275 0 1 0
## 2325 0 1 0
## 2398 0 1 0
## 2400 0 1 1
## 2430 0 0 1
## 2475 1 0 0
## 2500 0 0 1
## 2520 1 0 0
## 2550 1 0 0
## 2610 0 1 1
## 2640 1 0 0
## 2650 0 0 1
## 2684 0 0 1
## 2700 2 0 0
## 2747 0 1 0
## 2787 2 0 0
## 2800 0 1 1
## 2817 1 0 0
## 2835 0 1 0
## 2850 0 0 1
## 2856 1 0 0
## 2870 0 1 0
## 2880 0 1 1
## 2910 1 0 1
## 2953 0 0 1
## 2970 0 1 0
## 2990 0 0 1
## 3000 3 5 6
## 3036 0 1 0
## 3040 0 0 1
## 3060 0 0 1
## 3069 0 0 1
## 3090 0 1 1
## 3100 0 1 0
## 3120 1 1 1
## 3150 2 1 1
## 3162 1 0 0
## 3180 1 3 3
## 3185 1 0 2
## 3210 0 0 1
## 3240 0 2 1
## 3264 0 0 1
## 3290 1 0 0
## 3300 0 2 0
## 3350 0 0 1
## 3360 0 0 1
## 3400 0 1 0
## 3410 0 1 0
## 3420 0 3 1
## 3450 1 3 1
## 3460 1 1 0
## 3480 0 4 1
## 3500 2 1 3
## 3510 0 2 0
## 3512 0 0 1
## 3520 1 3 1
## 3540 0 1 0
## 3570 0 1 0
## 3584 0 1 0
## 3600 3 1 4
## 3620 0 0 1
## 3630 1 3 3
## 3635 0 0 1
## 3640 2 1 4
## 3649 0 0 1
## 3650 0 1 1
## 3660 0 0 1
## 3680 0 1 0
## 3700 1 0 0
## 3720 0 0 1
## 3745 1 0 0
## 3750 0 1 2
## 3760 0 2 0
## 3780 0 1 0
## 3792 0 1 0
## 3800 0 0 2
## 3816 1 0 0
## 3840 0 1 0
## 3850 0 1 4
## 3880 0 1 0
## 3900 0 0 1
## 3930 0 0 1
## 3934 0 0 1
## 3960 2 1 0
## 3968 0 1 0
## 3970 0 0 2
## 3986 0 0 1
## 3990 0 1 0
## 4000 2 5 4
## 4032 1 0 0
## 4040 1 3 3
## 4046 0 1 0
## 4050 1 0 1
## 4075 0 1 0
## 4079 0 1 0
## 4080 0 2 0
## 4095 0 2 0
## 4100 0 2 1
## 4120 0 1 1
## 4130 0 1 0
## 4160 0 0 2
## 4200 1 0 0
## 4240 0 1 0
## 4260 1 1 0
## 4280 0 1 0
## 4300 1 0 1
## 4320 1 2 1
## 4340 0 1 0
## 4350 0 0 2
## 4352 0 0 1
## 4360 1 0 0
## 4370 0 0 1
## 4400 0 2 2
## 4410 0 1 1
## 4500 5 6 2
## 4510 0 2 0
## 4520 0 1 0
## 4560 1 0 0
## 4600 2 3 0
## 4632 0 1 0
## 4640 0 1 0
## 4646 0 1 0
## 4700 1 0 0
## 4750 0 0 1
## 4770 0 1 0
## 4775 0 0 1
## 4785 1 0 0
## 4800 1 1 3
## 4815 0 1 0
## 4820 0 1 0
## 4840 0 1 1
## 4880 1 0 1
## 4900 0 1 1
## 4920 0 1 0
## 4950 0 1 0
## 4960 0 1 2
## 4990 1 0 0
## 4992 0 0 1
## 4995 0 1 0
## 5000 1 2 0
## 5010 0 1 0
## 5020 0 0 1
## 5040 0 0 1
## 5076 0 0 1
## 5136 0 0 1
## 5150 0 1 0
## 5170 0 1 0
## 5200 0 1 1
## 5300 0 1 2
## 5320 0 1 1
## 5360 0 0 1
## 5400 1 3 2
## 5450 1 1 0
## 5495 0 0 1
## 5500 2 5 2
## 5600 0 1 0
## 5640 0 1 0
## 5680 0 1 0
## 5700 1 0 0
## 5720 0 0 1
## 5750 0 0 1
## 5800 0 2 1
## 5828 0 1 0
## 5830 0 0 1
## 5850 0 1 1
## 5880 0 0 2
## 5885 0 0 1
## 5900 1 0 1
## 5948 0 1 0
## 5960 0 0 2
## 5985 0 1 0
## 6000 7 12 5
## 6020 0 1 0
## 6040 0 1 0
## 6050 0 1 0
## 6060 1 1 0
## 6100 1 2 0
## 6210 1 0 0
## 6240 1 0 0
## 6254 0 1 0
## 6300 0 1 0
## 6321 1 0 0
## 6325 0 0 1
## 6350 1 0 0
## 6360 5 1 1
## 6400 0 1 0
## 6420 2 1 1
## 6440 0 1 0
## 6450 0 1 1
## 6480 0 1 1
## 6500 1 0 1
## 6525 1 0 0
## 6540 2 1 0
## 6550 1 1 0
## 6600 3 3 3
## 6615 0 2 0
## 6650 0 1 0
## 6660 0 1 0
## 6670 0 0 1
## 6710 1 0 0
## 6720 0 0 1
## 6750 1 1 0
## 6800 1 0 1
## 6825 0 1 0
## 6840 1 0 0
## 6862 1 0 0
## 6900 0 1 1
## 6930 1 0 0
## 7000 2 2 1
## 7020 0 1 0
## 7085 0 1 0
## 7152 1 0 0
## 7155 0 0 1
## 7160 0 0 1
## 7200 1 1 0
## 7231 0 1 0
## 7260 1 0 0
## 7320 1 0 0
## 7350 0 1 0
## 7410 0 0 1
## 7420 2 0 0
## 7424 0 0 1
## 7440 0 1 1
## 7475 0 0 1
## 7482 1 0 0
## 7500 1 1 0
## 7600 1 0 0
## 7680 0 1 0
## 7686 0 1 0
## 7700 0 0 2
## 7770 1 0 0
## 7800 0 1 1
## 7950 0 0 1
## 7980 0 2 0
## 8000 0 1 0
## 8050 1 0 1
## 8080 0 1 0
## 8100 1 1 1
## 8150 0 1 0
## 8250 3 1 0
## 8372 0 0 1
## 8400 1 0 2
## 8500 1 0 0
## 8520 1 0 0
## 8580 1 1 0
## 8800 1 0 0
## 8875 0 1 0
## 8880 1 1 0
## 8960 1 0 0
## 9000 3 1 0
## 9166 0 1 0
## 9500 0 0 1
## 9620 1 0 0
## 9667 0 1 0
## 9800 0 1 0
## 9860 0 1 0
## 9960 0 1 0
## 10240 0 0 1
## 10269 0 1 0
## 10360 0 1 0
## 10500 1 2 0
## 10700 0 1 0
## 11175 1 0 0
## 11410 1 0 0
## 11440 0 1 0
## 11460 0 1 0
## 12090 1 0 0
## 12900 1 0 0
## 12944 0 0 1
## 13200 2 0 0
## 15600 0 1 0
## 16200 0 0 1TUẦN 3
3.1. Thống kê mô tả cho biến Mainroad
table(data$Mainroad)##
## no yes
## 77 468table(data$Mainroad)/sum(table(data$Mainroad))##
## no yes
## 0.1412844 0.8587156ggplot(data = data) +
geom_bar(aes(y = Mainroad), width = 0.3, fill = "gray") +
theme_minimal() +
labs(title = "Number of cases by Mainroad",
y = "Mainroad")
3.2. Thống kê mô tả cho biến Guestroom
table(data$Guestroom)##
## no yes
## 448 97table(data$Guestroom)/sum(table(data$Guestroom))##
## no yes
## 0.8220183 0.1779817ggplot(data = data) +
geom_bar(aes(y = Guestroom), width = 0.3, fill = "gray") +
theme_minimal() +
labs(title = "Number of cases by Guestroom",
y = "Guestroom")
3.3. Thống kê mô tả cho biến Basement
table(data$Basement)##
## no yes
## 354 191table(data$Basement)/sum(table(data$Basement))##
## no yes
## 0.6495413 0.3504587ggplot(data = data) +
geom_bar(aes(y = Basement), width = 0.3, fill = "gray") +
theme_minimal() +
labs(title = "Number of cases by Basement",
y = "Basement")
3.4. Thống kê mô tả cho biến HWH
table(data$HWH)##
## no yes
## 520 25table(data$HWH)/sum(table(data$HWH))##
## no yes
## 0.95412844 0.04587156ggplot(data = data) +
geom_bar(aes(y = HWH), width = 0.3, fill = "gray") +
theme_minimal() +
labs(title = "Number of cases by HWH",
y = "HWH")
3.5. Thống kê mô tả cho biến Airconditioning
table(data$Airconditioning)##
## no yes
## 373 172table(data$Airconditioning)/sum(table(data$Airconditioning))##
## no yes
## 0.6844037 0.3155963ggplot(data = data) +
geom_bar(aes(y = Airconditioning), width = 0.3, fill = "gray") +
theme_minimal() +
labs(title = "Number of cases by Airconditioning",
y = "Airconditioning")
3.6. Thống kê mô tả cho biến Prefarea
table(data$Prefarea)##
## no yes
## 417 128table(data$Prefarea)/sum(table(data$Prefarea))##
## no yes
## 0.7651376 0.2348624ggplot(data = data) +
geom_bar(aes(y = Prefarea), width = 0.3, fill = "gray") +
theme_minimal() +
labs(title = "Number of cases by Prefarea",
y = "Prefarea")
3.7. Thống kê mô tả cho biến FS
table(data$FS)##
## furnished semi-furnished unfurnished
## 140 227 178table(data$FS)/sum(table(data$FS))##
## furnished semi-furnished unfurnished
## 0.2568807 0.4165138 0.3266055ggplot(data = data) +
geom_bar(aes(y = FS), width = 0.3, fill = "gray") +
theme_minimal() +
labs(title = "Number of cases by FS",
y = "FS")
tmp <- table(data$Mainroad, data$Guestroom)
addmargins(tmp)##
## no yes Sum
## no 70 7 77
## yes 378 90 468
## Sum 448 97 545OddsRatio(tmp)## [1] 2.380952oddsratio(tmp)## $data
##
## no yes Total
## no 70 7 77
## yes 378 90 468
## Total 448 97 545
##
## $measure
## odds ratio with 95% C.I.
## estimate lower upper
## no 1.000000 NA NA
## yes 2.333381 1.103619 5.784347
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## no NA NA NA
## yes 0.02496765 0.03555412 0.0311128
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"TUẦN 4
4.1. Thống kê mô tả biến phụ thuộc : tổng diện tích (Area) với biến độc lập : kết nối với đường chính (Mainroad)
4.1.1. Mã hoá biến phụ thuộc (Area) từ định lượng sang định tính
Area <- cut(data$Area, breaks = c(0,5000,17000), labels=c("Nhỏ","Lớn"))
table(Area)## Area
## Nhỏ Lớn
## 309 2364.1.2. Bảng tần số, tần suất và biểu đồ
BẢNG TẦN SỐ:
M <- table(data$Mainroad, Area);M## Area
## Nhỏ Lớn
## no 69 8
## yes 240 228BẢNG TẦN SUẤT:
M1 <- prop.table(M);M1## Area
## Nhỏ Lớn
## no 0.1266055 0.0146789
## yes 0.4403670 0.4183486PHÂN PHỐI BIÊN:
addmargins(M)## Area
## Nhỏ Lớn Sum
## no 69 8 77
## yes 240 228 468
## Sum 309 236 545BIỂU ĐỒ CỘT:
library(data.table)## Warning: package 'data.table' was built under R version 4.3.1##
## Attaching package: 'data.table'## The following object is masked from 'package:DescTools':
##
## %like%m <- data.frame(data$Mainroad, data$Guestroom, data$Basement, data$HWH, data$Airconditioning, data$Prefarea, data$Area, Area)
m |> ggplot(aes(x=data$Mainroad,y=after_stat(count))) + geom_bar(fill="green") + geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = "count", color = "blue", vjust = - .5) + facet_grid(. ~Area) + labs(x = "Kết nối với đường chính",y = "Số ngôi nhà")
4.1.3. Rủi ro tương đối (Risk ratio)
library(epitools)
riskratio(M)## $data
## Area
## Nhỏ Lớn Total
## no 69 8 77
## yes 240 228 468
## Total 309 236 545
##
## $measure
## risk ratio with 95% C.I.
## estimate lower upper
## no 1.000000 NA NA
## yes 4.689103 2.417468 9.095336
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## no NA NA NA
## yes 2.179856e-11 2.41824e-11 3.174469e-10
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"Khi thêm tham số rev = “c” thì sẽ thực hiện việc đổi chỗ 2 cột trong bảng ngẫu nhiên:
riskratio(M, rev = "c")## $data
## Area
## Lớn Nhỏ Total
## no 8 69 77
## yes 228 240 468
## Total 236 309 545
##
## $measure
## risk ratio with 95% C.I.
## estimate lower upper
## no 1.000000 NA NA
## yes 0.572278 0.5093231 0.6430143
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## no NA NA NA
## yes 2.179856e-11 2.41824e-11 3.174469e-10
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"4.1.4. Tỷ lệ chênh lệch (odd ratio)
Khi thêm tham số rev = “r” thì sẽ thực hiện việc đổi chỗ 2 dòng trong bảng ngẫu nhiên:
epitab(M, method = "oddsratio", rev = "r")## $tab
## Area
## Nhỏ p0 Lớn p1 oddsratio lower upper p.value
## yes 240 0.776699 228 0.96610169 1.0000000 NA NA NA
## no 69 0.223301 8 0.03389831 0.1220442 0.05741208 0.2594366 2.41824e-11
##
## $measure
## [1] "wald"
##
## $conf.level
## [1] 0.95
##
## $pvalue
## [1] "fisher.exact"4.1.5. Thống kê suy diễn
Kiểm định tính độc lập cho 2 biến (Area) và (Mainroad):
Phương pháp chi bình phương: Giả thuyết Ho: Area và Mainroad độc lập
M <- table(data$Mainroad, Area);M## Area
## Nhỏ Lớn
## no 69 8
## yes 240 228chisq.test(M)##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: M
## X-squared = 38.018, df = 1, p-value = 7.008e-104.2. Thống kê mô tả biến phụ thuộc: tổng diện tích (Area) với biến độc lập: phòng khách (Guestroom)
4.2.1. Bảng tần số, tần suất và biểu đồ
BẢNG TẦN SỐ:
G <- table(data$Guestroom, Area);G## Area
## Nhỏ Lớn
## no 278 170
## yes 31 66BẢNG TẦN SUẤT:
G1 <- prop.table(G);G1## Area
## Nhỏ Lớn
## no 0.51009174 0.31192661
## yes 0.05688073 0.12110092PHÂN PHỐI BIÊN:
addmargins(G)## Area
## Nhỏ Lớn Sum
## no 278 170 448
## yes 31 66 97
## Sum 309 236 545BIỂU ĐỒ CỘT:
library(data.table)
g <- data.frame(data$Mainroad, data$Guestroom, data$Basement, data$HWH, data$Airconditioning, data$Prefarea, data$Area, Area)
g |> ggplot(aes(x=data$Guestroom,y=after_stat(count))) + geom_bar(fill="green") + geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = "count", color = "blue", vjust = - .5) + facet_grid(. ~Area) + labs(x = "Phòng khách",y = "Số ngôi nhà")
4.2.2. Rủi ro tương đối (Risk ratio)
epitab(G, method = "riskratio")## $tab
## Area
## Nhỏ p0 Lớn p1 riskratio lower upper p.value
## no 278 0.6205357 170 0.3794643 1.000000 NA NA NA
## yes 31 0.3195876 66 0.6804124 1.793087 1.496784 2.148045 7.279701e-08
##
## $measure
## [1] "wald"
##
## $conf.level
## [1] 0.95
##
## $pvalue
## [1] "fisher.exact"Khi thêm tham số rev = “c” thì sẽ thực hiện việc đổi chỗ 2 cột trong bảng ngẫu nhiên:
epitab(G, method = "riskratio", rev = "c")## $tab
## Area
## Lớn p0 Nhỏ p1 riskratio lower upper p.value
## no 170 0.3794643 278 0.6205357 1.0000000 NA NA NA
## yes 66 0.6804124 31 0.3195876 0.5150189 0.3818164 0.6946913 7.279701e-08
##
## $measure
## [1] "wald"
##
## $conf.level
## [1] 0.95
##
## $pvalue
## [1] "fisher.exact"4.2.3. Tỷ lệ chênh lệch (odd ratio)
epitab(G, method = "oddsratio")## $tab
## Area
## Nhỏ p0 Lớn p1 oddsratio lower upper p.value
## no 278 0.8996764 170 0.720339 1.000000 NA NA NA
## yes 31 0.1003236 66 0.279661 3.481594 2.181496 5.556507 7.279701e-08
##
## $measure
## [1] "wald"
##
## $conf.level
## [1] 0.95
##
## $pvalue
## [1] "fisher.exact"Khi thêm tham số rev = “r” thì sẽ thực hiện việc đổi chỗ 2 dòng trong bảng ngẫu nhiên:
epitab(G, method = "oddsratio", rev = "r")## $tab
## Area
## Nhỏ p0 Lớn p1 oddsratio lower upper p.value
## yes 31 0.1003236 66 0.279661 1.0000000 NA NA NA
## no 278 0.8996764 170 0.720339 0.2872248 0.1799692 0.458401 7.279701e-08
##
## $measure
## [1] "wald"
##
## $conf.level
## [1] 0.95
##
## $pvalue
## [1] "fisher.exact"4.2.4. Thống kê suy diễn
Kiểm định tính độc lập cho 2 biến (Area) và (Guestroom):
Phương pháp chi bình phương: Giả thuyết Ho: Area và Guestroom độc lập
G <- table(data$Guestroom, Area);G## Area
## Nhỏ Lớn
## no 278 170
## yes 31 66chisq.test(G)##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: G
## X-squared = 28.201, df = 1, p-value = 1.093e-074.3. Thống kê mô tả biến phụ thuộc: tổng diện tích (Area) với biến độc lập: tầng hầm (Basement)
4.3.1. Bảng tần số, tần suất và biểu đồ
BẢNG TẦN SỐ:
B <- table(data$Basement, Area);B## Area
## Nhỏ Lớn
## no 211 143
## yes 98 93BẢNG TẦN SUẤT:
B1 <- prop.table(B);B1## Area
## Nhỏ Lớn
## no 0.3871560 0.2623853
## yes 0.1798165 0.1706422PHÂN PHỐI BIÊN:
addmargins(B)## Area
## Nhỏ Lớn Sum
## no 211 143 354
## yes 98 93 191
## Sum 309 236 545BIỂU ĐỒ CỘT:
library(data.table)
b <- data.frame(data$Mainroad, data$Guestroom, data$Basement, data$HWH, data$Airconditioning, data$Prefarea, data$Area, Area)
b |> ggplot(aes(x=data$Guestroom,y=after_stat(count))) + geom_bar(fill="green") + geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = "count", color = "blue", vjust = - .5) + facet_grid(. ~Area) + labs(x = "Tầng hầm",y = "Số ngôi nhà")
4.3.2. Rủi ro tương đối (Risk ratio)
epitab(B, method = "riskratio")## $tab
## Area
## Nhỏ p0 Lớn p1 riskratio lower upper p.value
## no 211 0.5960452 143 0.4039548 1.00000 NA NA NA
## yes 98 0.5130890 93 0.4869110 1.20536 0.9939099 1.461795 0.07005549
##
## $measure
## [1] "wald"
##
## $conf.level
## [1] 0.95
##
## $pvalue
## [1] "fisher.exact"Khi thêm tham số rev = “c” thì sẽ thực hiện việc đổi chỗ 2 cột trong bảng ngẫu nhiên:
epitab(B, method = "riskratio", rev = "c")## $tab
## Area
## Lớn p0 Nhỏ p1 riskratio lower upper p.value
## no 143 0.4039548 211 0.5960452 1.0000000 NA NA NA
## yes 93 0.4869110 98 0.5130890 0.8608223 0.7316355 1.01282 0.07005549
##
## $measure
## [1] "wald"
##
## $conf.level
## [1] 0.95
##
## $pvalue
## [1] "fisher.exact"4.3.3. Tỷ lệ chênh lệch (odd ratio)
epitab(B, method = "oddsratio")## $tab
## Area
## Nhỏ p0 Lớn p1 oddsratio lower upper p.value
## no 211 0.6828479 143 0.6059322 1.000000 NA NA NA
## yes 98 0.3171521 93 0.3940678 1.400243 0.9824375 1.995729 0.07005549
##
## $measure
## [1] "wald"
##
## $conf.level
## [1] 0.95
##
## $pvalue
## [1] "fisher.exact"Khi thêm tham số rev = “r” thì sẽ thực hiện việc đổi chỗ 2 dòng trong bảng ngẫu nhiên:
epitab(B, method = "oddsratio", rev = "r")## $tab
## Area
## Nhỏ p0 Lớn p1 oddsratio lower upper p.value
## yes 98 0.3171521 93 0.3940678 1.000000 NA NA NA
## no 211 0.6828479 143 0.6059322 0.714162 0.5010699 1.017876 0.07005549
##
## $measure
## [1] "wald"
##
## $conf.level
## [1] 0.95
##
## $pvalue
## [1] "fisher.exact"4.2.4. Thống kê suy diễn
Kiểm định tính độc lập cho 2 biến (Area) và (Basement):
Phương pháp chi bình phương: Giả thuyết Ho: Area và Basement độc lập
B <- table(data$Basement, Area);B## Area
## Nhỏ Lớn
## no 211 143
## yes 98 93chisq.test(B)##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: B
## X-squared = 3.1478, df = 1, p-value = 0.076034.4. Thống kê mô tả biến phụ thuộc: tổng diện tích (Area) với biến độc lập: hệ thống đun nước nóng (HWH)
4.4.1. Bảng tần số, tần suất và biểu đồ
BẢNG TẦN SỐ:
H <- table(data$HWH, Area);H## Area
## Nhỏ Lớn
## no 293 227
## yes 16 9BẢNG TẦN SUẤT:
H1 <- prop.table(H);H1## Area
## Nhỏ Lớn
## no 0.53761468 0.41651376
## yes 0.02935780 0.01651376PHÂN PHỐI BIÊN:
addmargins(H)## Area
## Nhỏ Lớn Sum
## no 293 227 520
## yes 16 9 25
## Sum 309 236 545BIỂU ĐỒ CỘT:
library(data.table)
h <- data.frame(data$Mainroad, data$Guestroom, data$Basement, data$HWH, data$Airconditioning, data$Prefarea, data$Area, Area)
h |> ggplot(aes(x=data$Guestroom,y=after_stat(count))) + geom_bar(fill="green") + geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = "count", color = "blue", vjust = - .5) + facet_grid(. ~Area) + labs(x = "Hệ thống đun nước nóng",y = "Số ngôi nhà")
4.4.2. Rủi ro tương đối (Risk ratio)
epitab(H, method = "riskratio")## $tab
## Area
## Nhỏ p0 Lớn p1 riskratio lower upper p.value
## no 293 0.5634615 227 0.4365385 1.0000000 NA NA NA
## yes 16 0.6400000 9 0.3600000 0.8246696 0.4845798 1.403443 0.5379041
##
## $measure
## [1] "wald"
##
## $conf.level
## [1] 0.95
##
## $pvalue
## [1] "fisher.exact"Khi thêm tham số rev = “c” thì sẽ thực hiện việc đổi chỗ 2 cột trong bảng ngẫu nhiên:
epitab(H, method = "riskratio", rev = "c")## $tab
## Area
## Lớn p0 Nhỏ p1 riskratio lower upper p.value
## no 227 0.4365385 293 0.5634615 1.000000 NA NA NA
## yes 9 0.3600000 16 0.6400000 1.135836 0.8384475 1.538705 0.5379041
##
## $measure
## [1] "wald"
##
## $conf.level
## [1] 0.95
##
## $pvalue
## [1] "fisher.exact"4.4.3. Tỷ lệ chênh lệch (odd ratio)
epitab(H, method = "oddsratio")## $tab
## Area
## Nhỏ p0 Lớn p1 oddsratio lower upper p.value
## no 293 0.94822006 227 0.96186441 1.0000000 NA NA NA
## yes 16 0.05177994 9 0.03813559 0.7260463 0.3150642 1.673129 0.5379041
##
## $measure
## [1] "wald"
##
## $conf.level
## [1] 0.95
##
## $pvalue
## [1] "fisher.exact"Khi thêm tham số rev = “r” thì sẽ thực hiện việc đổi chỗ 2 dòng trong bảng ngẫu nhiên:
epitab(H, method = "oddsratio", rev = "r")## $tab
## Area
## Nhỏ p0 Lớn p1 oddsratio lower upper p.value
## yes 16 0.05177994 9 0.03813559 1.000000 NA NA NA
## no 293 0.94822006 227 0.96186441 1.377323 0.5976824 3.173957 0.5379041
##
## $measure
## [1] "wald"
##
## $conf.level
## [1] 0.95
##
## $pvalue
## [1] "fisher.exact"4.4.4. Thống kê suy diễn
Kiểm định tính độc lập cho 2 biến (Area) và (HWH):
Phương pháp chi bình phương: Giả thuyết Ho: Area và HWH độc lập
H <- table(data$HWH, Area);H ## Area
## Nhỏ Lớn
## no 293 227
## yes 16 9chisq.test(H)##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: H
## X-squared = 0.30009, df = 1, p-value = 0.58384.5. Thống kê mô tả biến phụ thuộc: tổng diện tích (Area) với biến độc lập: hệ thống điều hòa nhiệt độ (Airconditioning)
4.5.1. Bảng tần số, tần suất và biểu đồ
BẢNG TẦN SỐ:
A <- table(data$Airconditioning, Area);A## Area
## Nhỏ Lớn
## no 249 124
## yes 60 112BẢNG TẦN SUẤT:
A1 <- prop.table(H);A1## Area
## Nhỏ Lớn
## no 0.53761468 0.41651376
## yes 0.02935780 0.01651376PHÂN PHỐI BIÊN:
addmargins(A)## Area
## Nhỏ Lớn Sum
## no 249 124 373
## yes 60 112 172
## Sum 309 236 545BIỂU ĐỒ CỘT:
library(data.table)
a <- data.frame(data$Mainroad, data$Guestroom, data$Basement, data$HWH, data$Airconditioning, data$Prefarea, data$Area, Area)
a |> ggplot(aes(x=data$Guestroom,y=after_stat(count))) + geom_bar(fill="green") + geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = "count", color = "blue", vjust = - .5) + facet_grid(. ~Area) + labs(x = "Hệ thống điều hòa nhiẹt độ",y = "Số ngôi nhà")
4.5.2. Rủi ro tương đối (Risk ratio)
epitab(A, method = "riskratio")## $tab
## Area
## Nhỏ p0 Lớn p1 riskratio lower upper p.value
## no 249 0.6675603 124 0.3324397 1.00000 NA NA NA
## yes 60 0.3488372 112 0.6511628 1.95874 1.634964 2.346633 3.548088e-12
##
## $measure
## [1] "wald"
##
## $conf.level
## [1] 0.95
##
## $pvalue
## [1] "fisher.exact"Khi thêm tham số rev = “c” thì sẽ thực hiện việc đổi chỗ 2 cột trong bảng ngẫu nhiên:
epitab(A, method = "riskratio", rev = "c")## $tab
## Area
## Lớn p0 Nhỏ p1 riskratio lower upper p.value
## no 124 0.3324397 249 0.6675603 1.0000000 NA NA NA
## yes 112 0.6511628 60 0.3488372 0.5225553 0.4208826 0.6487892 3.548088e-12
##
## $measure
## [1] "wald"
##
## $conf.level
## [1] 0.95
##
## $pvalue
## [1] "fisher.exact"4.5.3. Tỷ lệ chênh lệch (odd ratio)
epitab(A, method = "oddsratio")## $tab
## Area
## Nhỏ p0 Lớn p1 oddsratio lower upper p.value
## no 249 0.8058252 124 0.5254237 1.000000 NA NA NA
## yes 60 0.1941748 112 0.4745763 3.748387 2.562265 5.483589 3.548088e-12
##
## $measure
## [1] "wald"
##
## $conf.level
## [1] 0.95
##
## $pvalue
## [1] "fisher.exact"Khi thêm tham số rev = “r” thì sẽ thực hiện việc đổi chỗ 2 dòng trong bảng ngẫu nhiên:
epitab(A, method = "oddsratio", rev = "r")## $tab
## Area
## Nhỏ p0 Lớn p1 oddsratio lower upper p.value
## yes 60 0.1941748 112 0.4745763 1.0000000 NA NA NA
## no 249 0.8058252 124 0.5254237 0.2667814 0.1823623 0.3902797 3.548088e-12
##
## $measure
## [1] "wald"
##
## $conf.level
## [1] 0.95
##
## $pvalue
## [1] "fisher.exact"4.5.4. Thống kê suy diễn
Kiểm định tính độc lập cho 2 biến (Area) và (Airconditioning):
Phương pháp chi bình phương: Giả thuyết Ho: Area và Airconditioning độc lập
A <- table(data$Airconditioning, Area);A ## Area
## Nhỏ Lớn
## no 249 124
## yes 60 112chisq.test(A)##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: A
## X-squared = 47.417, df = 1, p-value = 5.737e-12TUẦN 5
library(tidyverse)## Warning: package 'tidyverse' was built under R version 4.3.1## Warning: package 'tidyr' was built under R version 4.3.1## Warning: package 'readr' was built under R version 4.3.1## Warning: package 'purrr' was built under R version 4.3.1## Warning: package 'dplyr' was built under R version 4.3.1## Warning: package 'forcats' was built under R version 4.3.1## Warning: package 'lubridate' was built under R version 4.3.1## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.2 ✔ readr 2.1.4
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ lubridate 1.9.2 ✔ tibble 3.2.1
## ✔ purrr 1.0.1 ✔ tidyr 1.3.0
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::between() masks data.table::between()
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::first() masks data.table::first()
## ✖ lubridate::hour() masks data.table::hour()
## ✖ lubridate::isoweek() masks data.table::isoweek()
## ✖ dplyr::lag() masks stats::lag()
## ✖ dplyr::last() masks data.table::last()
## ✖ lubridate::mday() masks data.table::mday()
## ✖ lubridate::minute() masks data.table::minute()
## ✖ lubridate::month() masks data.table::month()
## ✖ lubridate::quarter() masks data.table::quarter()
## ✖ lubridate::second() masks data.table::second()
## ✖ purrr::transpose() masks data.table::transpose()
## ✖ lubridate::wday() masks data.table::wday()
## ✖ lubridate::week() masks data.table::week()
## ✖ lubridate::yday() masks data.table::yday()
## ✖ lubridate::year() masks data.table::year()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(tidyselect)## Warning: package 'tidyselect' was built under R version 4.3.1library(dplyr)
library(caTools)## Warning: package 'caTools' was built under R version 4.3.1data$Mainroad<- as.factor(data$Mainroad)
data$Guestroom<- as.factor(data$Guestroom)
data$Basement<- as.factor(data$Basement)
data$HWH<- as.factor(data$HWH)
data$Airconditioning<- as.factor(data$Airconditioning)
data$Prefarea<- as.factor(data$Prefarea)
data$FS<- as.factor(data$FS)1. Ma trận hệ số tương quan
continuous_vars <- data[, sapply(data, is.numeric)]
cor_matrix <- cor(continuous_vars)
cor_matrix## Price Area Bedrooms Bathrooms Stories Parking ...15
## Price 1.0000000 0.53599735 0.3664940 0.5175453 0.42071237 0.38439365 NA
## Area 0.5359973 1.00000000 0.1518585 0.1938195 0.08399605 0.35298048 NA
## Bedrooms 0.3664940 0.15185849 1.0000000 0.3739302 0.40856424 0.13926990 NA
## Bathrooms 0.5175453 0.19381953 0.3739302 1.0000000 0.32616471 0.17749582 NA
## Stories 0.4207124 0.08399605 0.4085642 0.3261647 1.00000000 0.04554709 NA
## Parking 0.3843936 0.35298048 0.1392699 0.1774958 0.04554709 1.00000000 NA
## ...15 NA NA NA NA NA NA 1