DỮ LIỆU CỦA TUẦN 1
Tập dữ liệu “Automobile Bodily Injury Claims” được thu thập từ Insurance Research Council (IRC). Dữ liệu này thu thập vào năm 2002 và bao gồm thông tin về người yêu cầu bồi thường, đại diện luật sư và thiệt hại kinh tế (LOSS, tính bằng nghìn đô), cùng với các biến khác. Trong tập dữ liệu này, chúng ta xem xét một mẫu gồm n = 1.340 yêu cầu bồi thường từ một bang duy nhất
Dữ liệu trên có 8 biến bao gồm :
CASENUM: Số hồ sơ để xác định yêu cầu bồi thường, là một số nguyên.
ATTORNEY: Cho biết người yêu cầu bồi thường có được đại diện bởi một luật sư hay không. Giá trị 1 nếu có đại diện luật sư và giá trị 2 nếu không có.
CLMSEX: Giới tính của người yêu cầu bồi thường. Giá trị 1 nếu là nam và giá trị 2 nếu là nữ.
MARITAL: Tình trạng hôn nhân của người yêu cầu bồi thường. Giá trị 1 nếu đã kết hôn, giá trị 2 nếu độc thân, giá trị 3 nếu góa vợ/chồng, và giá trị 4 nếu đã ly thân/ly dị.
CLMINSUR: Tình trạng bảo hiểm của người lái xe của người yêu cầu bồi. Giá trị 1 nếu có bảo hiểm, giá trị 2 nếu không có bảo hiểm, và giá trị 3 nếu không áp dụng.
SEATBELT: Cho biết người yêu cầu bồi thường có đang đeo dây an toàn/giữ trẻ em trong xe không. Giá trị 1 nếu có đeo, giá trị 2 nếu không đeo, và giá trị 3 nếu không áp dụng.
CLMAGE: Tuổi của người yêu cầu bồi thường, là một số nguyên.
LOSS: Tổng thiệt hại kinh tế của người yêu cầu bồi thường, tính theo đơn vị nghìn đô.
data("AutoBi")
dat <- AutoBi
dat <- na.omit(dat)
names(dat) <- c("case","att","sex","mar","ins","seat","age","los")
dat <- dat %>% mutate(sexn = case_when(sex == 1 ~"Nam", sex == 2 ~ "Nữ"))
datatable(dat)
Trong phần này em sẽ tạo hàm để có thể vẽ một số biểu đồ dựa trên bộ dữ liệu được đưa vào 3 biến số, trong đó sẽ có một biến dùng để phân biệt các cột với nhau.
plotcb <- function(data, x, y, group) {
library(ggplot2)
varx <- data[[x]]
vary <- data[[y]]
varg <- data[[group]]
# đồ thị scatter
scatter <- ggplot(data, aes(x = varx, y = vary, color = varg )) +
geom_point() +
geom_smooth(aes(color = varg), formula = y ~ x, method = "lm") +
labs(x = "x", y = "y")
# Đồ thị cột biến y
bar1 <- data %>% mutate(
ynew = cut( vary,breaks = c(0,20,50,Inf),
labels = c("thấp","trung","cao"))
) %>%
ggplot(aes(x= ynew, y = after_stat(count), fill = ynew))+
geom_bar()+
geom_text(aes(label= scales::percent(after_stat(count/sum(count)), accuracy = 0.01)), stat='count', color= 'black', vjust= -0.5 ) +
labs(x= y ,y= "số người", fill = y)
# Đồ thị cột của biến group
bar2 <- ggplot(data, aes(x = varg, y = after_stat(count), fill = varg )) +
geom_bar() +
geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'black', vjust = - .3) +
theme_classic() +
labs(x = group , y = 'Số người' , fill = group )
# Xuất các đồ thị
print(scatter)
print(bar1)
print(bar2 )
}
Đầu tiên trong hàm plotcb sẽ có tham số là data, các biến khai bao trong data này sẽ là biến x, biến y, group- biến này được dùng để phân nhóm dữ liêu.
Hàm này có chức năng đầu tiên là vẽ đồ thị scatter theo biến x,y được phân màu sắc theo biến group được khai báo vào, ngoài ra có kẻ đường hồi quy theo màu sắc của các nhóm dữ liệu
Tiếp theo, biến ynew sẽ được phân ra làm mức độ dựa vào biến y ban đầu từ đó thực hiện vẽ biểu đồ cột cho biến ynew và có thể hiện tỷ lệ trên mỗi cột
Cuối cùng, hàm sẽ biểu hiện số lượng của mỗi giá trị trong biến group
plotcb(dat, "age", "los", "sexn" )
Sau khi Sử dụng hàm plotcb ta sẽ vẽ được các đồ thị như trên. Bộ dữ liệu đưa vào là dat, biến được khai báo là “age”, “los” và biến “sexn” được dùng để phân dữ liệu theo hai nhóm giới tính trong các biểu đồ
Tạo hàm để vẽ các đồ thị cho dữ liệu WDI
plotwdi <- function(data, x, y, color) {
ggplot(data, aes_string(x = x, y = y, color = color)) +
geom_line() +
labs(x = x, y = y)
}
library(WDI)
d1 <- WDI(indicator ="EN.ATM.CO2E.KT")
d1 <- na.omit(d1)
datatable(d1)
EN.ATM.CO2E.KT là mã indicator trong WDI đại diện cho “Carbon dioxide emissions (kt)”. Indicator này đo lường khí thải carbon dioxide (CO2) gây ra bởi sự đốt cháy nhiên liệu hóa thạch và sản xuất xi măng. Khí thải CO2 là một trong những loại khí gây hiệu ứng nhà kính chính, đóng góp vào sự tăng nhiệt toàn cầu
chỉ số này cho phép ta theo dõi và so sánh khí thải CO2 giữa các quốc gia và theo thời gian, giúp đánh giá mức độ ảnh hưởng của các hoạt động công nghiệp và sử dụng năng lượng đến biến đổi khí hậu và môi trường.
Dữ liệu gồm có 5 biến, biến đầu tiên là country thể hiện tên của các quốc gia. iến iso2c là mã của quốc gia trong đó mỗi quốc gia được đại diện bằng hai ký tự. Biến iso3c là mã quốc gia theo chuẩn ISO trong đó mỗi quốc gia được đại diện bằng ba ký tự. Year thể hiện năm dữ liệu thu thập.Biến EN.ATM.CO2E.KT là lượng khí thải CO2 của quốc gia tương ứng với các năm cụ thể, đơn vị đo lường là kiloton. Nguồn của dữ liệu từ Climate Watch Historical GHG Emissions ( 1990-2020 ).
countries <- c("Euro area","East Asia & Pacific","Arab World","Latin America & Caribbean","North America")
d1n <- filter(d1, country %in% countries )
d1n %>% ggplot(aes(x= year , y =EN.ATM.CO2E.KT , color = country))+
geom_line()+
labs(x= "year" , y= "kt" )
Ngoài ra, ta cũng có thể lọc một số vùng lãnh thổ rồi sau đó vẽ đồ thị để có nhìn tổng quát. Dựa vào đồ thị có thể nhận thấy rằng Nam Á & Thái Bình Dương có lượng khí thải C02 tăng mạnh nhất trong các vùng lãnh thổ từ năm 1990-2020, năm 1990 vùng này có 4322250.3 (kiloton) lượng khí thải CO2 tuy nhiên đến năm 2022 lượng khí thải tăng lên đến 14708135.6(kt). Vùng Arab có lượng khí thải CO2 thấp nhất trong giai đoạn 1990-2010, đến khoảng năm 2015 thì có xu hướng tăng hơn vùng Mỹ Latinh& Caribbean.
d2 <- WDI(country = c("XD","XM","XP") ,indicator ="FP.CPI.TOTL.ZG" )
d2 <- na.omit(d2)
datatable(d2)
FP.CPI.TOTL.ZG là mã indicator trong dữ liệu WDI (World Development Indicators) và nó đại diện cho tỉ lệ tăng trưởng CPI (Chỉ số giá tiêu dùng) tổng hợp trong một quốc gia cụ thể.
Tỉ lệ tăng trưởng CPI tổng hợp (CPI growth rate) là tỷ lệ tăng trưởng của chỉ số giá tiêu dùng trong một khoảng thời gian cụ thể. Nó cho biết mức độ biến đổi của giá cả trong quốc gia đó. Một số giá trị dương của chỉ số này cho thấy mức tăng trưởng của CPI, tức là giá cả đang tăng. Ngược lại, các giá trị âm cho thấy mức giảm của CPI, tức là giá cả đang giảm.
Chỉ số này sử dụng để theo dõi sự biến đổi của mức giá tiêu dùng trong một quốc gia và đánh giá tình hình lạm phát. Nó là một trong những chỉ số quan trọng để đánh giá tình trạng kinh tế và ảnh hưởng đến đời sống của người dân.
Tương tự, dữ liệu này gồm có biến country, iso2c , iso3c, year và biến FP.CPI.TOTL.ZG thể hiện tốc độ tăng trưởng CPI của các quốc gia qua các năm. Dữ liệu được thu thập bởi International Monetary Fund, International Financial Statistics
plotwdi(d2, "year", "FP.CPI.TOTL.ZG", "country")
## Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
## ℹ Please use tidy evaluation idioms with `aes()`.
## ℹ See also `vignette("ggplot2-in-packages")` for more information.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
Tỉ lệ tăng trưởng CPI ở các quốc có thu nhập cao tương đối thấp hơn tỷ lệ tăng trưởng CPI ở các quốc gia có thu nhập trung và thấp. Tỷ lệ này quốc gia thu nhập thấp có sự biến động mạnh mẽ năm 1990 chỉ số này chỉ có khoảng 6% đến năm 1994 thì khoảng 20% và giảm một cách mạnh mẽ về mức 1.7% trong năm 1999.
d3 <- WDI(country = c("VN","JP","KR","AU","LA","ID","TH"),indicator ="CM.MKT.TRAD.CD", latest = 20)
datatable(d3)
Indicator trên đại diện cho giá trị vốn hóa thị trường của các quốc gia. Giá trị giao dịch cổ phiếu là tổng số cổ phiếu được giao dịch, bao gồm cả cổ phiếu nội địa và cổ phiếu nước ngoài, nhân với giá phù hợp tương ứng. Dữ liệu được tính dựa trên giá trị cuối năm chuyển đổi thành đô la Mỹ bằng tỷ giá hối đoái ngoại tệ tại cuối năm tương ứng.
Chỉ số này giúp phân tích sự phát triển và tăng trưởng của thị trường chứng khoán, hiểu về thành phần và giá trị của các công ty niêm yết, và theo dõi sự thay đổi vốn hóa thị trường theo thời gian. Đây là một chỉ số quan trọng để đánh giá đóng góp của thị trường tài chính đối với nền kinh tế của một quốc gia và vai trò của nó trong thu hút đầu tư và thúc đẩy tăng trưởng kinh tế.
Dữ liệu trong d3 chỉ lấy ở một số quốc gia thay vì là tất cả các quốc gia và khoảng thời gian được chọn là 20 năm gần nhất. Bộ dữ liệu gồm các biến là tên, mã số của các quốc, năm thu thập và tổng giá trị cổ phiếu giao dịch được tính bằng đô.
plotwdi(d3,"year", "CM.MKT.TRAD.CD", "country")
Dựa vào đồ thị, Việt Nam là quốc gia có vốn hóa thị trường thấp nhất và không có sự tăng trưởng cao trong các quốc gia được xem xét, đến năm 2020 thị vốn hóa thị trường là 56858820000 đô. Nhật Bản là quốc gia có vốn hóa lớn nhất và cũng có sự biến động khá lớn trong giai đoạn 2005-2020, đến năm 2022 thì quốc gia này đạt hơn 6 nghìn tỷ đô.
d4 <- WDI(country = "1W",indicator ="SP.POP.TOTL" )
datatable(d4)
Đây là dữ liệu về tổng dân số của các quốc gia trên thế giới. Chỉ số này đo lường số lượng dân cư trên một địa lý cụ thể, không phân biệt về tình trạng pháp lý hoặc quốc tịch của các cư dân. Giá trị hiển thị là ước tính giữa năm.
Dân số là yếu tố quan trọng trong việc đánh giá sự phát triển của một quốc gia. Sự gia tăng dân số, bất kể do di cư hay tỉ lệ sinh cao hơn tỉ lệ tử, có thể ảnh hưởng đến tài nguyên tự nhiên và cơ sở hạ tầng xã hội. Tăng trưởng dân số đáng kể có thể ảnh hưởng tiêu cực đến việc có đất cho sản xuất nông nghiệp và tăng nhu cầu về thực phẩm, năng lượng, nước, dịch vụ xã hội và cơ sở hạ tầng. Ngược lại, giảm kích thước dân số - kết quả của tỉ lệ sinh ít hơn tỉ lệ tử và người di cư ra khỏi một quốc gia - có thể ảnh hưởng đến cam kết của chính phủ trong việc duy trì dịch vụ và cơ sở hạ tầng.
Các ước tính dân số thường dựa trên cuộc điều tra dân số quốc gia. Các ước tính cho các năm trước và sau cuộc điều tra được xây dựng dựa trên các mô hình dân số. Tuy nhiên, sai số và sự thiếu sót có thể xảy ra, đặc biệt là trong các nước đang phát triển do hạn chế về tài nguyên vận chuyển, truyền thông và phân tích cuộc điều tra dân số đầy đủ.
Bộ dữ liệu lấy về dân số thế giới, mã của nó, biến năm thu thập ứng năm và dữ liệu tương ứng
plotwdi(d4,"year", "SP.POP.TOTL", "country")
Ta nhận thấy dân số tăng trưởng khá mạnh từ năm 1960-2020, năm 1960 chỉ có khoảng 3 tỷ người những đến năm 2020 dân số khoảng 7.9 tỷ người.
d5 <- WDI(indicator ="BX.KLT.DINV.CD.WD" , start = 2000)
datatable(d5)
Foreign direct investment, net inflows (BoP, current US$) là một indicator đo lường lưu lượng vốn đầu tư trực tiếp từ nước ngoài vào nền kinh tế của một quốc gia trong một khoảng thời gian nhất định. Nó bao gồm tổng số vốn về từ vốn góp vốn, tái đầu tư lợi nhuận và vốn khác. Đầu tư trực tiếp là một loại đầu tư vượt biên liên quan đến một cá nhân hoặc tổ chức thuộc một nền kinh tế có sự kiểm soát hoặc ảnh hưởng đáng kể đến quản lý của một doanh nghiệp thuộc một nền kinh tế khác. Điều kiện để xác định sự tồn tại của mối quan hệ đầu tư trực tiếp là sở hữu 10% trở lên số lượng cổ phiếu thông thường có quyền biểu quyết. Dữ liệu được tính bằng đơn vị đô la Mỹ và được lấy từ năm 2000 trở về sau.
d5 <- filter(d5,country == "United States" )
plotwdi(d5,"year", "BX.KLT.DINV.CD.WD", "country")
Dòng vốn FDI của Mỹ có sự biến động mạnh mẽ qua các năm, năm 2002 Mỹ có vốn FDI thấp nhất là khoảng 111 tỷ đô và năm 2015 đạt cao nhất khoảng 500 tỷ đô
d6 <- WDI(country= c("CN","VN","US"),indicator ="SL.UEM.TOTL.ZS")
d6 <- na.omit(d6)
datatable(d6)
Tỷ lệ thất nghiệp được ước tính theo phương pháp mô phỏng ILO là một indicator trong dữ liệu phát triển thế giới (WDI). Nó được tính bằng cách so sánh số lượng người lao động không có việc làm, đang tìm kiếm việc làm và có sẵn cho công việc với tổng số lực lượng lao động của một quốc gia.
Tỷ lệ thất nghiệp có thể là một chỉ số quan trọng để đo lường mức độ tăng trưởng kinh tế, tạo việc làm và sự phát triển xã hội trong một quốc gia. Tỷ lệ thất nghiệp thấp có thể cho thấy một nền kinh tế ổn định và tạo điều kiện cho người lao động có việc làm, trong khi tỷ lệ thất nghiệp cao có thể chỉ ra sự mất cân đối và khó khăn trong thị trường lao động.
plotwdi(d6,"year", "SL.UEM.TOTL.ZS", "country")
Tỷ lệ thất nghiệp của Việt Nam khá thấp thường nằm dưới mức 3%, tỷ lệ thất nghiệp của Mỹ cao nhất trong 3 quốc gia và có sự biến động lớn, tỷ lệ thất nghiệp của Mỹ có thể đạt đến 9.6% năm 2010 và giảm xuống mức thấp nhất vào năm 2019 là 3.6%. Tỉ lệ này ở Trung Quốc có xu hướng tăng qua các năm từ mức 2.5% lên đến khoảng 5%.
d7 <- WDI(country= c("EU", "8S","ZH"),indicator ="SP.DYN.LE00.IN")
datatable(d7)
Indicator “Life expectancy at birth, total (years)” là một chỉ số thống kê về tuổi thọ khi sinh, tức là số năm trung bình mà một em bé mới sinh được dự kiến sống nếu mô hình tử vong tại thời điểm sinh của nó không thay đổi trong suốt cuộc đời.
Chỉ số này có ý nghĩa quan trọng trong việc đo lường tình trạng sức khỏe của một quốc gia. Nó cho thấy mức độ tử vong tổng thể trong dân số và tóm lược mô hình tử vong tồn tại ở tất cả các nhóm tuổi trong một năm cụ thể. Nó được tính dựa trên bảng tuổi thọ theo giai đoạn, cung cấp một cái nhìn tổng quan về mô hình tử vong của dân số tại một thời điểm nhất định.
Tuy nhiên, chỉ số này cũng có giới hạn và ngoại lệ. Dữ liệu hàng năm dựa trên Dự báo Dân số Thế giới của Liên Hiệp Quốc thường là dữ liệu nội suy từ dữ liệu chu kỳ 5 năm. Do đó, chúng có thể không phản ánh chính xác các sự kiện thực tế. Ngoài ra, chỉ số này chỉ cho thấy mô hình tử vong tổn tại trong một năm cụ thể, không phản ánh mô hình tử vong mà một người thực sự trải qua trong cuộc đời.
plotwdi(na.omit(d7),"year", "SP.DYN.LE00.IN", "country")
Nhìn chung cả ba vùng đều có tuổi thọ khi sinh tăng lên qua các năm. Vùng Africa Eastern and Southern có tuổi thấp nhất trong 3 vùng và liên minh Châu Âu có tuổi cao nhất tăng từ 70 tuổi lên đến khoảng 80 tuổi trong giai đoạn 1960-2020. Ở Nam Á thì tuổi thọ tăng lên khá cao trong giai đoạn trên, tăng từ 45 tuổi lên đến 70 tuổi
d8 <- WDI(country = c( "US" , "JP","CH"), indicator ="SH.XPD.CHEX.PC.CD")
d8 <- na.omit(d8)
datatable(d8)
Đây là một chỉ số đo lường các chi tiêu hiện tại trên mỗi người trong lĩnh vực y tế. Nó đại diện cho số tiền chi trả hiện tại cho y tế trên mỗi cá nhân tính bằng đô la Mỹ.
Chỉ số này tính toán các chi tiêu hiện tại trong lĩnh vực y tế bao gồm các hàng hóa và dịch vụ y tế được sử dụng trong mỗi năm. Nó đo lường số tiền trung bình mà mỗi người dân chi trả cho các dịch vụ y tế, bao gồm cả viện trợ y tế, chi phí điều trị và các dịch vụ y tế khác. Nó cho biết mức độ sẵn sàng và khả năng của một quốc gia trong việc cung cấp dịch vụ y tế cho dân số. Mức chi tiêu y tế cao hơn có thể đồng nghĩa với việc có sự đầu tư tốt hơn vào hệ thống y tế, đảm bảo tiếp cận và chất lượng dịch vụ tốt hơn cho người dân.
Tuy nhiên, chỉ số này cũng có nhược điểm là không cho thấy sự phân bố công bằng của các chi tiêu y tế. Một quốc gia có mức chi tiêu y tế cao trên mỗi người dân không đồng nghĩa với việc đảm bảo mọi người dân đều có cơ hội tiếp cận đến dịch vụ y tế. Do đó, để đánh giá toàn diện về tình hình y tế của một quốc gia, cần phải xem xét thêm các chỉ số khác như tiếp cận dịch vụ y tế, chất lượng dịch vụ và công bằng trong phân phối các nguồn lực y tế.
plotwdi(d8,"year", "SH.XPD.CHEX.PC.CD", "country")
Số tiền chi trả y tế trên mỗi cá nhân ở nước Nhật thấp nhất trong 3 quốc gia (cao nhất là khoảng 5235 đô năm 2012 ). Mỹ chi trả cho y tế nhiều nhất và có tốc độ tăng trưởng cao trong giai đoạn 2000-2020 ,đạt 11702.409 đô vào năm 2020. Thụy Sĩ cũng có mức chi trả cho y tế cao và tăng không đều qua các năm, đạt 10309.763 đô vào năm 2020.
d9 <- WDI(country = "1W" , indicator ="EG.FEC.RNEW.ZS")
d9 <- na.omit(d9)
datatable(d9)
Chỉ số trên đại diện cho tỷ lệ tiêu thụ năng lượng tái tạo trong tổng năng lượng tiêu thụ cuối cùng. Nó đo lường phần trăm năng lượng được tạo ra từ các nguồn năng lượng tái tạo như năng lượng mặt trời, năng lượng gió, thủy điện, sinh học và địa nhiệt so với tổng lượng năng lượng tiêu thụ cuối cùng.
Chỉ số này cung cấp thông tin về mức độ phụ thuộc của một quốc gia vào nguồn năng lượng tái tạo, nhằm so sánh với việc sử dụng năng lượng tổng thể cho mục đích cuối cùng. Giá trị cao hơn cho thấy một sự phụ thuộc lớn hơn vào năng lượng tái tạo và giảm sự phụ thuộc vào các nguồn không tái tạo như than đá, dầu và khí tự nhiên.
Dữ liệu cho chỉ số này thường được thu thập từ các cơ quan năng lượng quốc gia, cơ quan thống kê và tổ chức quốc tế như Cơ quan Năng lượng Quốc tế (IEA) và Ngân hàng Thế giới.
plotwdi(d9,"year", "EG.FEC.RNEW.ZS", "country")
Tỷ lệ tiêu thụ năng lượng tái tạo của thế vào năm 1990 là khoảng 16.6% tăng lên đến 19.7% vào năm 2020, có sự sụt giảm trong giai đoạn 2000- 2005
d10 <- WDI(country = c("CN" , "GB", "FR") ,indicator ="SE.XPD.PRIM.ZS")
d10 <- na.omit(d10)
datatable(d10)
Chỉ số này đại diện cho tỷ lệ chi tiêu cho giáo dục tiểu học so với tổng chi tiêu chung của chính phủ cho giáo dục. Chi tiêu chung của chính phủ thường bao gồm chính phủ địa phương, khu vực và trung ương. Dữ liệu cho chỉ số này thường được thu thập từ các cơ quan giáo dục quốc gia, cơ quan thống kê và tổ chức quốc tế như UNESCO và Ngân hàng Thế giới.
Việc theo dõi tỷ lệ chi tiêu cho giáo dục tiểu học trong tổng chi tiêu chung của chính phủ là quan trọng để đánh giá mức độ đầu tư và phát triển giáo dục cơ bản. Đầu tư vào giáo dục tiểu học đóng vai trò quan trọng trong việc xây dựng nền tảng giáo dục cho trẻ em và đảm bảo quyền tiếp cận giáo dục cho tất cả các em nhỏ.
plotwdi(d10,"year", "SE.XPD.PRIM.ZS", "country")
Trong giai đoạn 1980 - 2000 tỷ lệ chi tiêu cho giáo dục tiểu học ở Pháp là thấp nhất và có xu hướng giảm, Trung quốc có tỷ lệ đầu tư cho giáo dục cao hơn tuy nhiên có sự biến động khá cao, dao động từ 30% đến 40%. United Kingdom có xu hướng đầu tư cho giáo dục tiểu học tăng, đạt khoảng 32.3 vào năm 2016
library(rvest)
url <- "https://www.imdb.com/search/title/?title_type=tv_series&genres=action&sort=num_votes,desc&start=1&explore=title_type,genres"
web <- read_html(url)
movie <- web %>% html_elements(".lister-item-header a") %>% html_text()
vote <- web %>% html_elements(".text-muted+ span") %>% html_text()
vote <- gsub(",","",vote) %>% as.numeric(vote)
des <- web %>% html_elements(".ratings-bar+ .text-muted") %>% html_text()
gen <- web %>% html_elements(".genre") %>% html_text()
rate <- web %>% html_elements(".ratings-imdb-rating strong") %>% html_text()
rate<- as.numeric(rate)
time <- web %>% html_elements(".runtime") %>% html_text()
time <- gsub(" min","",time) %>% as.numeric(time)
time1 <- c(time[1:15], NA, NA, time[16:length(time)])
year <- web %>% html_elements(".text-muted.unbold") %>% html_text() %>% str_replace_all("[()]", "")
df <- data.frame(movie = movie ,
year = year,
time = time1,
gen = gen,
rate = rate,
vote = vote,
des = des
)
datatable(df)
-Mô tả thao tác và bộ dữ liệu sau khi scrape:
Trước tiên cần đọc đường dẫn bằng lệnh read_html cho biến url,
sau đó chọn các thành phần muốn lấy bằng hàm html_elements
và xuất thông tin ở dạng text bằng hàm html_text(). Cuối
cùng là biến đổi các dữ liệu và sau đó lập thành một dataframe tên
df
Biến movie là danh sách tên các bộ phim
Biến year là năm của phim
Biến time là thời lượng phim được tính bằng phút , sau khi lấy về thì ta cần bỏ “min” trong dữ liệu để có thể chuyển cột này sang kiểu num
Gen là thể loại của phim
Rate là điểm đánh giá của mọi người dành cho phim này, dữ liệu này lấy về ở dạng chr nên cần chuyển nó sang num
Vote thể hiện số người tham gia bình chọn
Des là mô tả những thông tin trong phim
df %>% summarise(min = min(rate), max = max(rate), mean = mean(rate))
## min max mean
## 1 5.3 9.3 8.228
na.omit(df) %>% summarise(min = min(time), max = max(time), mean = mean(time) )
## min max mean
## 1 15 70 44.85417
hrate <- filter(df, rate > 9)
datatable(hrate)
t <- filter(df, time > 50 & time < 60 )
datatable(t)
Có 10 bộ phim có thời lượng trên 50 phút và nhỏ hơn 60 phút
g <- filter(df, grepl("Crime", gen ) )
datatable(g)
Tương tự các tuần trước,em gán dữ liệu vào biến dat sau khi đã bỏ đi các dữ liệu na và đặt tên cho các biến trong bộ dữ liệu
library(insuranceData)
data("AutoBi")
dat <- AutoBi
dat <- na.omit(dat)
Đặt tên cho các biến trong bộ dữ liệu
names(dat) <- c("case","att","sex","mar","ins","seat","age","los")
datatable(dat)
Tạo các cột mới trong bộ dữ liệu dat với giá trị trong mỗi cột được gán tên tương ứng
dat <- dat %>% mutate(sexn = case_when(sex == 1 ~"Nam", sex == 2 ~ "Nữ"))
dat <- dat %>% mutate(atn = case_when(att == 1 ~"luatsu", att == 2 ~ "kluatsu"))
dat <- dat %>% mutate(stn = case_when(seat == 1 ~"thatday", seat== 2 ~ "khongthatday"))
dat <- dat %>% mutate(marn = case_when(mar == 1 ~"kethon", mar== 2 ~ "docthan",mar == 3~"goa",mar == 4 ~ "lyhon"))
dat <- dat %>% mutate(l= cut(los, breaks = c(0,10,20,Inf), labels = c("thấp","trung","cao") ))
-Trong data “dat” ta có thể lọc được các giá trị trong các biến bằng lệnh filter sao cho phù hợp nhu cầu về phân tích dữ liệu
nam <- dat %>% filter(sexn == "Nam")
num <- nrow(nam)
print (num)
## [1] 475
Có 475 người có giới tính là nam trong bộ dữ liệu
nam <- dat %>% filter(sexn == "Nam" & marn == "docthan")
num <- nrow(nam) %>% print ()
## [1] 243
l5 <- dat %>% filter( los > 5 )
num <- nrow(l5) %>% print ()
## [1] 209
l6 <- dat %>% filter( los > 10 | atn == "luatsu" )
num <- nrow(l6) %>% print ()
## [1] 581
l7 <- dat %>% filter( los < 5 & stn == "thatday" ) %>% nrow() %>% print ()
## [1] 869
i <- dat %>% filter ( ins == 1 ) %>% nrow() %>% print ()
## [1] 105
table(dat$ins)
##
## 1 2
## 105 986
prop.table(table(dat$ins))
##
## 1 2
## 0.09624198 0.90375802
-Lập bảng cho biến tình trạng bảo hiểm của người lái xe cho ta có được kết quả là: Gồm 105 người tài xế lái xe có bảo hiểm (chiếm tỷ lệ là 9.6%) và số người không có bảo hiểm là 986 người ( 90.4%), số người lái xe không có bảo hiểm gấp khoảng 9.4 lần số ngưới có bảo hiểm
dat <- dat %>% mutate(agen = cut (age , breaks = c(-1, 30, 50, Inf ), labels = c("Duoi 30", "30-50", " tren 50")))
table(dat$agen,dat$sexn)
##
## Nam Nữ
## Duoi 30 222 308
## 30-50 182 225
## tren 50 71 83
Ta nhận thấy số người ở độ tuổi dưới 30 là 530 người,đạt số lượng cao nhất ở các độ tuổi, trong có thì nam là 222 người và nữ là 308 người. Ngược lại, số người trên 50 tuổi là thấp nhất có 154 người gồm 71 nam và 83 nữ. Nhìn chung thì số người nữ ở các độ tuổi cao hơn nam
table(dat$marn)
##
## docthan goa kethon lyhon
## 534 12 516 29
prop.table(table(dat$marn))
##
## docthan goa kethon lyhon
## 0.48945921 0.01099908 0.47296059 0.02658112
-Số người độc thân chiếm cao nhất trong tổng số là 534 người chiếm khoảng 47.2%. Số người góa vợ/ chồng đạt thấp nhất là 12 người chiếm khoảng 1%
summary(dat$los)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.005 0.753 2.435 5.326 4.189 273.604
Hàm summary để tạo ra một báo cáo tóm tắt các thông tin thống kê mô tả của các biến. Summary cho biến tổng thiệt hại của người yêu cầu bồi thường cho kết quả là: người có tổng thiệt hại thấp nhất là 5 đô, người có tổng thiệt hại lớn nhất là khoảng 273 nghìn đô, trung bình thiệt hại là khoảng 5 nghìn đô. Hơn thế, các tứ phân vị thứ nhất, thứ hai, thứ ba lần lượt cho biết có 25% người có thiệt hại dưới mức 0.75 nghìn đô, có 50% người có thiệt hại dưới mức 2.4 nghìn đô và 75% người có thiệt hại dưới mức 4.2 nghìn đô
max(dat$los)
## [1] 273.604
min(dat$los)
## [1] 0.005
-Tổng thiệt hại của người khảo sát đạt cao nhất là 273.604 nghìn đô và mức thiệt hại thấp nhất nằm ở khoảng 5 đô
mean(dat$los)
## [1] 5.326176
mean(dat$age)
## [1] 32.63795
-Lệnh mean cho biết tổng thiệt hại trung bình là khoảng 5.3 nghìn đô. Độ tuổi trung bình là khoảng 32 tuổi
quantile(dat$los, 0.60)
## 60%
## 3.034
-Kết quả từ hàm quantile cho biết có 60% người có tổng thiệt hại ở nhỏ hơn hoặc bằng mức 3.034 nghìn đô
var(dat$los)
## [1] 261.6165
sd(dat$los)
## [1] 16.17456
-Phương sai của thiệt hại là 261.6165 và độ lệnh chuẩn là 16.17456 hai số liệu này tương đối lớn, điều này có ý nghĩa sự biến động của các giá trị thiệt hại khá lớn.
aggregate( los ~ atn, dat,FUN = mean )
## atn los
## 1 kluatsu 1.850248
## 2 luatsu 8.456934
-Những người có luật sự đại diện thì trung bình tổng thiệt hại là 8.6 nghìn đô. Những người không có luật sư đại điện thì có trung bình tổng thiệt hại là 1.85 nghìn đô
dat %>% group_by(sexn) %>% summarise(trungbinh = mean(age), caonhat= max(age) )
## # A tibble: 2 × 3
## sexn trungbinh caonhat
## <chr> <dbl> <int>
## 1 Nam 32.8 95
## 2 Nữ 32.5 88
-Hàm summarise được dùng để tính tổng hợp các phép tính trung bình và max được phân theo giới tính. Nam có tuổi trung bình là 32.8 cao hơn nữ giới với tuổi trung bình là 32.4. Tuổi cao nhất ở nam là 95 tuổi, tuy nhiên tuổi cao nhất ở nữ là 88 tuổi
group_by(dat,stn) %>% summarise(mean=mean(los),sum=sum(los), sd = sd(los))
## # A tibble: 2 × 4
## stn mean sum sd
## <chr> <dbl> <dbl> <dbl>
## 1 khongthatday 21.0 420. 40.7
## 2 thatday 5.03 5391. 15.2
-Nhóm người có cài dây an toàn thì trung bình thiệt hại là 5.03 nghìn đô thấp hơn trung bình nhóm người không có đeo dây an toàn (21 nghìn đô ). Tuy nhiên thì tổng thiệt hại của người có đeo dây an toàn lại lớn hơn những người không có đeo dây (lớn hơn 4972 nghìn đô). Độ lệnh chuẩn của thiệt hại những người không đeo thắt dây khá lớn là 40.7, tuy nhiên ở nhóm có thắt dây chỉ có 15.2.
table4a
## # A tibble: 3 × 3
## country `1999` `2000`
## <chr> <dbl> <dbl>
## 1 Afghanistan 745 2666
## 2 Brazil 37737 80488
## 3 China 212258 213766
table4a %>% pivot_longer(cols = "1999":"2000", names_to = "year", values_to = "case")
## # A tibble: 6 × 3
## country year case
## <chr> <chr> <dbl>
## 1 Afghanistan 1999 745
## 2 Afghanistan 2000 2666
## 3 Brazil 1999 37737
## 4 Brazil 2000 80488
## 5 China 1999 212258
## 6 China 2000 213766
Từ dữ liệu ban đầu ta có thể chuyển sang dạng dài trong đó năm được xếp về một cột và những trường hợp mắc bệnh được gom về cùng một cột tương ứng với quốc gia và năm
table2
## # A tibble: 12 × 4
## country year type count
## <chr> <dbl> <chr> <dbl>
## 1 Afghanistan 1999 cases 745
## 2 Afghanistan 1999 population 19987071
## 3 Afghanistan 2000 cases 2666
## 4 Afghanistan 2000 population 20595360
## 5 Brazil 1999 cases 37737
## 6 Brazil 1999 population 172006362
## 7 Brazil 2000 cases 80488
## 8 Brazil 2000 population 174504898
## 9 China 1999 cases 212258
## 10 China 1999 population 1272915272
## 11 China 2000 cases 213766
## 12 China 2000 population 1280428583
table2 %>% pivot_wider(names_from = type, values_from = count)
## # A tibble: 6 × 4
## country year cases population
## <chr> <dbl> <dbl> <dbl>
## 1 Afghanistan 1999 745 19987071
## 2 Afghanistan 2000 2666 20595360
## 3 Brazil 1999 37737 172006362
## 4 Brazil 2000 80488 174504898
## 5 China 1999 212258 1272915272
## 6 China 2000 213766 1280428583
Từ dữ liệu table2 ban đầu ở dạng dữ liệu dài ta có thể chuyển sang dữ liệu dạng rộng bằng hàm pivot_wider, các giá trị trong cột type ban đầu đầu sẽ được tạo thành các cột mới và tương ứng với số người trong cột count ban đầu
-Lập bảng thống kê về giới tính
table(dat$sex)
##
## 1 2
## 475 616
prop.table(table(dat$sex))
##
## 1 2
## 0.4353804 0.5646196
-Đồ thị cột và biểu đồ tròn
dat %>% ggplot(aes(x = sexn, y = after_stat(count))) +
geom_bar(fill = 'blue') +
geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'black', vjust = - .3) +
theme_classic() +
labs(x = 'Giới tính', y = 'Số người')
dat %>% count(sexn) %>% mutate(per=n/sum(n)) %>%
ggplot(aes(x="",y=per,fill= sexn))+
geom_bar(stat="identity")+
coord_polar("y", start = 0)+
geom_text(aes(label=scales::percent(per)),position=position_stack(vjust=0.5),color='white',size=5)+
labs(fill = " Giới tính ", title="BIỂU ĐỒ TRÒN GIỚI TÍNH ") +
theme_void()
Nhận xét về các biểu đồ giới tính: Có 616 người nữ chiếm tỷ lệ khoảng 56% và 475 nam chiếm tỷ lệ 44%. Vì vậy, nữ lớn hơn nam khoảng 141 người khoảng 12% dựa vào độ trên lệch giữa hai cột.
-Lập bảng và vẽ đồ thị giới tính phân nhóm theo tình trạng luật sư đại diện
table(dat$sexn,dat$atn)
##
## kluatsu luatsu
## Nam 199 276
## Nữ 318 298
prop.table(table(dat$sexn,dat$atn))
##
## kluatsu luatsu
## Nam 0.1824015 0.2529789
## Nữ 0.2914757 0.2731439
dat %>% ggplot(aes(x = sexn, y = after_stat(count),fill=sexn)) +
geom_bar() +
geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'black', vjust = - 0.3) +
facet_grid(. ~ atn) +
theme_light() +
labs(x = " Giới tính ", y = "Số người")
Đồ thị và các bảng bên trên cho ta biết nữ chiếm khoảng 56,4%(616 người) trong tổng những người được khảo sát, trong 56,4% đó thì chia ra nữ mà có luật sư đại diện là khoảng 27.3% (298 người) và nữ mà không có luật sư đại diện là 29.1% (318 người) .
Ngược lại, tỷ lệ nam chiếm khoảng 43.5% (475) so với tổng số người khảo sát, trong đó có 18.2% nam không có luật sư đại diện (199 người ) và 25.3% nam có luật sư đại diện(276 người).
Trong nhóm có luật sư đại diện và nhóm không có luật sư đại diện thì nữ vẫn luôn chiếm tỷ lệ cao hơn nam.
table(dat$marn)
##
## docthan goa kethon lyhon
## 534 12 516 29
prop.table(table(dat$marn))
##
## docthan goa kethon lyhon
## 0.48945921 0.01099908 0.47296059 0.02658112
Bảng thống kê cho biết những người có tình trạng độc thân có số lượng lớn nhất là 534 người(48.9595%), ngược lại số người góa vợ/chồng có 12 người chiếm ít nhất (1.1%)
dat %>% count(marn) %>% mutate(p = scales::percent(n/sum(n), accuracy = 0.01)) %>%
ggplot(aes(x = marn, y = n,fill = marn)) +
geom_col() +
geom_text(aes(label = p),color = 'black ', vjust = 1, size = 4) +
theme_classic() +
labs(x = 'Tình trạng hôn nhân', y = 'Số người')
Dựa vào đồ thị và bảng thống kê cho thấy người có tình trạng độc thân và kết hôn chiếm phần lớn, có 534 người độc thân chiếm khoảng 48.95% và có 516 người kết hôn chiếm khoảng 47.3%. Ngược lại những người góa và ly hôn chiếm tỷ lệ rất nhỏ so với tổng người được khảo sát, trong đó số người góa vợ/chồng có 12 người chiếm tỷ lệ 1.1% và số người ly hôn có 29 người chiếm tỷ lệ 2.66%
table(dat$marn,dat$l)
##
## thấp trung cao
## docthan 502 16 16
## goa 10 2 0
## kethon 465 25 26
## lyhon 22 4 3
dat %>% count(marn, l) %>% group_by(marn) %>% mutate(p = n/sum(n)) %>%
ggplot(aes(x= marn, y = n, fill= l))+
geom_col()+
geom_text(aes(label= scales::percent(p, accuracy = 0.01)), position = position_stack(vjust = 0.5), size = 3)+
labs(x= " tình trạng ", y = " số người ", fill= " mức thiệt hại ")
-Mức thiệt hại thấp thì chiếm cao nhất và mức thiệt hại cao thì chiếm thấp nhất trong các nhóm tình trạng hôn nhân. Nhóm người có tình trạng độc thân chiếm số lượng lớn nhất là 534 người, trong nhóm này có 502 người có mức thiệt hại là thấp ( khoảng 94.01% so với tổng nhóm người độc thân) và 16 người có thiệt hại trung (3%) va cao (3%). Nhóm góa có số lượng thấp nhất là 12 người, phần lớn trong nhóm này là những người có thiệt hại thấp 10 người (chiếm tỷ lệ 83.3% trong nhóm) và 2 người thiệt hại trung bình (16.7%), nhóm này không có người có thiệt hại mức cao. Tương tự số người có thiệt hại thấp ở nhóm kết hôn và ly hôn lần lượt là 465 người ( 90.12% so với tổng người kết hôn) và 22 người ( tỷ lệ là 75.86 so với nhóm người ly hôn ), tuy nhiên ở nhóm người kết hôn thì mức thiệt hại trung thì chiếm thấp nhất có 25 người ( 4.84%), trong nhóm ly hôn thì người có mức thiệt hại cao có số lượng ít nhất là 3 người (10.3%)
table(dat$sexn,dat$marn)
##
## docthan goa kethon lyhon
## Nam 243 1 220 11
## Nữ 291 11 296 18
prop.table(table(dat$sexn,dat$marn))
##
## docthan goa kethon lyhon
## Nam 0.2227314390 0.0009165903 0.2016498625 0.0100824931
## Nữ 0.2667277727 0.0100824931 0.2713107241 0.0164986251
dat %>% ggplot(aes ( x = marn , y = after_stat(count ), fill = marn ))+
geom_bar()+
geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color= "white",vjust = -0.5, size = 4)+
facet_grid(. ~ sexn) +
theme_dark() +
labs(x = " Tình trạng hôn nhân ", y = "Số người", fill = " tình trạng ")
Từ bảng tần số và đồ thị bên trên ta thấy rằng: Tỷ lệ về các nhóm tình trạng hôn nhân của nữ luôn cao của nam và nhóm người độc thân, kết hôn ở hai nhóm giới tính chiếm phần lớn, trong khi đó nhóm góa và ly hôn chiếm rất thấp. Ở nhóm trình trạng độc thân thì có 243 người nam chiếm tỷ lệ 22.27% so với tổng số người và có 291 người nữ độc thân chiếm tỷ lệ là 26.67%. Trong nhóm người đã kết hôn thì có 296 nữ (27.13) cao hơn số người nam đã kết hôn ( 220 người và tỷ lệ là 20.16%). Tương tự, nhóm góa đạt số lượng người thấp nhầt với nữ là 11 người (1.01%) và số người nam là 1 người (0.09%).
dat %>%group_by(atn) %>%summarise(mean_los = mean(los))
## # A tibble: 2 × 2
## atn mean_los
## <chr> <dbl>
## 1 kluatsu 1.85
## 2 luatsu 8.46
dat %>%group_by(atn) %>%summarise(mean_los = mean(los)) %>%
ggplot(aes(x = atn, y = mean_los, fill = atn)) +
geom_col() +
geom_text(aes(label = round(mean_los, 2)), vjust = -0.5, color = "black") +
ylab("Thiệt hại trung bình") +
xlab("Luật sư") +
scale_fill_manual(values = c("luatsu" = "brown", "kluatsu" = "skyblue"))
Phân theo nhóm luật sư để có thể tính tổng thiệt hại trung bình của từng nhóm. Dựa vào đó ta thấy rằng tổng thiệt hại trung bình của những người có luật sư là 8.46 (nghìn đô), tuy nhiên tổng thiệt hại của nhóm người không có luật sư là 1.85 (nghìn đô). Vì vậy tổng thiệt hại trung bình của nhóm có luật sư lớn hơn nhóm không có luật sư và mức chênh lệch về trung bình tổng thiệt hại của hai nhóm là 6.61 nghìn đô
dat %>% ggplot(map = aes(x = age, y = los)) +
geom_smooth(formula = y ~ x, method = 'lm', color = 'blue') +
geom_point(color = 'brown') +
labs(title = 'Đồ Thị Scatter của tuổi và tổng thiệt hại', x = 'Tuổi', y = 'Thiệt hại')
Đồ thị trên cho thấy rằng sự thay đổi của độ tuổi không ảnh hưởng nhiều đến tổng thiệt hại kinh về. Nhìn chung tổng thiệt hại theo tuổi phần lớn đều nằm dưới mức 50(nghìn đô) ở các mức tuổi khác nhau, một số người có mức thiệt hại lớn 50 nghìn đô thì năm ở độ tuổi khoảng 25 đến 50 tuổi. Ngoài ra đường hồi quy nằm ngang và không có độ dốc lớn thì cho ta biết khi độ tuổi tăng lên thì không ảnh hưởng nhiều đến sự thay đổi của tổng thiệt hại.
dat %>% ggplot(aes(x=age,y=los,color=atn))+
geom_point()+
geom_smooth(formula = y~x, method = 'lm')+
labs( x = 'Tuổi', y = 'Thiệt hại')
dat %>% ggplot(aes(x = age, y = los)) +
geom_point(aes(color=atn))+
geom_smooth(formula = y~x,method = 'lm', color="red")+
facet_grid(.~atn)+
labs( x = 'Tuổi', y = 'Thiệt hại')
Từ đồ thị nhận thấy rằng, đường hồi quy của tổng thiệt hại theo tuổi ở nhóm có luật sư nằm phía trên và có độ dốc lớn hơn đường hồi quy nhóm không có luật sư . Vì vậy tổng thiệt hại ở nhóm có luật sư thay đổi lớn hơn. Khi tuổi tăng lên thì tổng thiệt hại ở nhóm có luật sư sẽ tăng hơn so với nhóm không có luật sư. Ngoài ra thì ở nhóm có luật sự có một số điểm phân bố xa đường hồi quy hơn so với nhóm không có luật sư, cho thấy rằng nó có sự biến động về tổng thiệt hại nhiều hơn.
dat %>% ggplot(aes( x = age, y = los , color = sexn ))+
geom_line()+
theme_gray()+
labs(x = 'Tuổi', y = 'Thiệt hại', color = 'Giới tính')
Đồ thị đường biểu diễn mối quan hệ của tuổi và thiệt hại được phân theo giới tính là hai đường khác nhau. Nhìn chung cả hai đường đều không có sự khác biệt rõ rệt cho thấy tuổi ở cả hai giới tính không ảnh hưởng nhiều đến thiệt hại. Tuy nhiên đường biểu diễn về sự thay đổi thiệt hại theo tuổi ở nhóm nữ có sự biến động hơn.
-Tạo cột mới tên losnew để phân các mức thiệt hại ra và sau đó là lập bảng dựa vào biến thiệt hại mới và giới tính. Tiếp theo dùng để trực quan hóa số liệu.
dat <- dat %>% mutate(losnew = cut(los,breaks = c(0,20,50,Inf), labels = c("thấp","trung","cao")))
table(dat$sexn,dat$losnew)
##
## thấp trung cao
## Nam 452 16 7
## Nữ 594 14 8
prop.table(table(dat$sexn,dat$losnew))
##
## thấp trung cao
## Nam 0.414298808 0.014665445 0.006416132
## Nữ 0.544454629 0.012832264 0.007332722
dat %>% ggplot(aes(x= losnew, y = after_stat(count), fill = losnew))+
geom_bar()+
geom_text(aes(label= scales::percent(after_stat(count/sum(count)), accuracy = 0.01)), stat='count', color= 'black', vjust= -0.5 ) +
facet_grid(.~sexn)+
labs(x= "Mức thiệt hại",y= "số người", fill = " mức thiệt hại ")
-Nhận xét: Dựa vào biểu đồ và bảng thống kê phía trên, hai giới tính thì phần lớn có mức thiệt hại là thấp, mức thiệt hại trung và cao chiếm rất thấp (nhỏ hơn 2%). Mức thiệt hại thấp chiếm tỷ lệ 95.88% (1046 người) tổng số người khảo sát trong đó thì nữ chiếm 54.45% có 594 người và những người nam có mức thiệt thấp là 452 người với tỷ lệ là 41.43%. Nam có mức thiệt hại trung là 16 người có tỷ lệ là 1.47%, nữ có mức thiệt hại trung là 14 người (1.28%). Mức thiệt hại cao thì chiếm thấp nhất trong 3 mức, cụ thể nam có 7 người (0.64%), nữ có 8 người (0.73%).
dat %>% ggplot(aes(x = age, y = los)) +
geom_point(aes(color=sexn))+
geom_smooth(formula = y~x,method = 'lm', color="red")+
facet_grid(.~sexn)+
labs( x = 'Tuổi', y = 'Thiệt hại')
Đồ thị bên trên thể hiện độ phân tán giữa tuổi và thiệt hại được phân chia ở hai nhóm giới tính nam và nữ. Nhìn tổng quan thì ở hai nhóm giới tính đều có sự tập chung ở phần dưới đồ thị phân tán, điều này cho thấy thiệt hại nằm ở mức khá thấp như đã được thống kê phần trên. Hơn thế, sự thay đổi về độ tuổi không ảnh hưởng nhiều đến sự thay đổi thiệt hại ở cả hai nhóm giới tính.
-Trước tiên, em phân biến tuổi chia làm ba nhóm để phân tích và dựa vào đó lập bảng tần số, tần suất và vẽ đồ thị.
dat <- dat %>% mutate(agen = cut(age, breaks = c(-1, 30, 50, 95), labels = c("Duoi 30", "30-50", " tren 50")))
table(dat$agen)
##
## Duoi 30 30-50 tren 50
## 530 407 154
prop.table(table(dat$agen))
##
## Duoi 30 30-50 tren 50
## 0.4857929 0.3730522 0.1411549
dat %>% count(agen) %>% mutate(per=n/sum(n)) %>%
ggplot(aes(x="",y=per,fill=agen))+
geom_bar(stat="identity",width=1 )+
coord_polar("y", start = 0)+
geom_text(aes(label=scales::percent(per)),position=position_stack(vjust=0.5),color='white',size=5)+
labs(fill = "Nhóm Tuổi", title="BIỂU ĐỒ TRÒN NHÓM TUỔI") +
theme_void()
-Nhận xét dựa vào kết quả bên trên: CHiếm khoảng 49% người khảo sát là người có độ tuổi dưới 30 (530 người). Độ tuổi 30 đến 50 thì có 407 người ( tỷ lệ là 37%). Nhóm người trên 50 tuổi thì chiếm tỷ lệ thấp nhất là 14% có 154 người. Nhóm tuổi dưới 30 thì gấp khoảng 3.5 nhóm tuổi trên 50.
table(dat$agen,dat$sexn)
##
## Nam Nữ
## Duoi 30 222 308
## 30-50 182 225
## tren 50 71 83
prop.table(table(dat$agen,dat$sexn))
##
## Nam Nữ
## Duoi 30 0.20348304 0.28230981
## 30-50 0.16681943 0.20623281
## tren 50 0.06507791 0.07607699
dat %>%
count(sexn, agen) %>%
ggplot(aes(x = agen, y = n, fill = sexn )) +
geom_bar(position = "stack", stat = "identity") +
geom_text(aes(label = n), position = position_stack(vjust = 0.5), size = 4) +
labs(x = "Nhóm tuổi", y = "Số người")
Ta nhận thấy số người ở độ tuổi dưới 30 là 530 người,đạt số lượng cao nhất ở các độ tuổi. Ngược lại, số người trên 50 tuổi là thấp nhất có 154 người. Nhìn chung ở các nhóm tuổi thì số lượng nữ chiếm cao hơn số lượng nam, trong đó ở nhóm tuổi dưới 30 thì số người nữ có 308 người lớn hơn số người nam (222), tương tự ở nhóm 30 đến 50 tuổi thì số người nữ là 225 người cao hơn số người nam (182 người) và những người trên 50 tuổi thì có 83 người là nữ và 71 người là nam.
dat %>%
group_by(sexn) %>%
summarise(meanage = mean(age)) %>%
ggplot(aes(x = sexn, y = meanage, fill = sexn)) +
geom_col() +
geom_text(aes(label = round(meanage, 2)), vjust = 1.5, size=6 , color = 'white') +
ylab("Tuổi trung bình") +
xlab("Giới tính")
Đồ thị cho thấy độ tuổi trung bình của những người khảo sát được phân theo giới tính. Nhóm giới tính nam có độ tuổi trung bình là 32.82 cao hơn tuổi trung bình của giới tính nữ (32.5)
table(dat$agen,dat$l)
##
## thấp trung cao
## Duoi 30 504 13 13
## 30-50 356 29 22
## tren 50 139 5 10
dat %>% count(agen,l) %>%
ggplot(aes(x=agen,y=n,fill=l))+
geom_bar(position= "stack", stat= "identity")+
geom_text(aes(label = n), position = position_stack(vjust = 0.5), size = 4) +
labs(x = "Nhóm tuổi", y = "Số người")
dat %>% count(agen,l) %>% group_by(agen) %>% mutate(p=n/sum(n)) %>%
ggplot(aes(x=agen,y=n,fill=l))+
geom_col()+
geom_text(aes(label=scales::percent(p,accuracy=0.01)), position=position_stack(vjust = 0.5),size=3)+
labs(x='nhóm tuổi',y= 'số người')
Dựa vào bảng và đồ thị nhóm tuổi phân ra theo các mức thiệt hại ta nhận thấy rằng: Nhìn tổng quan ở mọi nhóm tuổi thì tổng thiệt hại phần lớn là ở mức thấp (dưới 10 nghìn đô) và mức thiệt hại trung và cao chiếm rất thấp, số người dưới 30 có nhiều nhất và số người trên 50 thì thấp nhất. Cụ thể, trong nhóm dưới 30 tuổi thì có 504 người có thiệt hại mức thấp chiếm tỷ lệ là 95.09%, tuy nhiên chỉ có 13 người có thiệt hại ở mức trung (2.45%) và 13 có thiệt hại ở mức cao (2.45%). Tương tự, độ tuổi 30-50 có 356 người có thiệt hại mức thấp chiếm tỷ lệ là 87.47%, số người có thiệt hại ở mức cao là thấp nhất trong nhóm tuổi này (22 người chiếm tỷ lệ là 5.41%). Trong nhóm tuổi trên 50 thì số người đạt mức thiệt hại cao là 139 người (90.26%), tuy nhiên chỉ có 5 người ở mức thiệt hại trung với tỷ lệ khoảng 3.25%
Tương tự các tuần trước,em gán dữ liệu vào biến dat sau khi đã bỏ đi các dữ liệu na và đặt tên cho các biến trong bộ dữ liệu
library(insuranceData)
data("AutoBi")
dat <- AutoBi
dat <- na.omit(dat)
names(dat) <- c("case","att","sex","mar","ins","seat","age","los")
datatable(dat)
Tạo 4 biến mới gán vào biến dat dựa vào giá trị trong các cột giới tính, luật sự đại diện và tình trạng thắt dây an toàn và hôn nhân.
dat <- dat %>% mutate(sexn = case_when(sex == 1 ~"Nam", sex == 2 ~ "Nữ"))
dat <- dat %>% mutate(atn = case_when(att == 1 ~"luatsu", att == 2 ~ "kluatsu"))
dat <- dat %>% mutate(stn = case_when(seat == 1 ~"thatday", seat== 2 ~ "khongthatday"))
dat <- dat %>% mutate(marn = case_when(mar == 1 ~"kethon", mar== 2 ~ "docthan",mar == 3~"goa",mar == 4 ~ "lyhon"))
dat %>% ggplot(map = aes(x = age, y = los)) + geom_point(color = 'brown')
Thêm tên và vẽ đường hồi qui cho đồ thị
dat %>% ggplot(map = aes(x = age, y = los)) +
geom_smooth(formula = y ~ x, method = 'lm', color = 'red') +
geom_point(color = 'blue') +
labs(title = 'Đồ Thị Scatter của tuổi và tổng thiệt hại', x = 'Tuổi', y = 'Thiệt hại')
Nhận xét: Đồ thị trên cho thấy rằng sự thay đổi của độ tuổi không ảnh hưởng nhiều đến tổng thiệt hại kinh về. Nhìn chung tổng thiệt hại theo tuổi phần lớn đều nằm dưới mức 50(nghìn đô) ở các mức tuổi khác nhau
Ngoài ra, ta có thể thêm màu cho đồ thị trên dựa vào giới tính Nam và Nữ.
dat %>% ggplot(aes(x = age, y = los, color=sexn)) +
geom_point()+
labs(title = 'Tuổi và tổng thiệt hại theo giới tính', x = 'Tuổi', y = 'Thiệt hại')
Đồ thị cho thấy sự phân tán về tuổi và tổng thiệt hại của giới tính nam và nữ khá tương đồng nhau. Cả hai giới tính đều có tổng thiệt hại ở mức thấp mặc dù độ tuổi có sự thay đổi.
dat %>% ggplot(aes(x = age, y = los)) +
geom_point(aes(color=atn))+
labs( x = 'Tuổi', y = 'Thiệt hại')
Đồ thị phân tán của tuổi và tổng thiệt hại phía trên được chia màu theo luật sư đại diện. Có thể thấy phần màu xanh là “có luật sư” đại diện được phân tán nằm bên trên phần màu đỏ là ” không có luật sư”, có nghĩa là những người có luật sư thì có thiệt hại lớn hơn những người không có luật sư
dat %>% ggplot(aes(x = age, y = los,shape=sexn,color=sexn)) +
geom_point(size=2.5)+
xlab('Tuổi')+ylab('Thiệt hại')
Biểu đồ bên trên được phân theo giới tính, hình tròn là nam và tam giác là nữ
dat %>% ggplot(aes(x = age, y = los,shape=sexn,color=sexn)) +
geom_point(size=2.5)+
xlab('Tuổi')+ylab('Thiệt hại')+
scale_shape_manual(values = c("Nam" = 17, "Nữ" = 15))+
scale_color_manual(values = c("Nam" = "red", "Nữ" = "blue"))
Để dễ phân biệt giới tính em đặt hình dạng và màu sắc riêng cho từng giới. Đồ thị phân tán phía trên cho thấy sự thay đổi tuổi cả nam và nữ cũng không thay đổi nhiều đến tổng thiệt hại.
dat %>% ggplot(aes(x=age,y=los,shape=sexn))+
geom_point(color='black',size=2)+
geom_point(data=dat %>% filter(atn=="luatsu"),size=2,color='red')+
labs( x = 'Tuổi', y = 'Thiệt hại')
Biểu đồ trên cũng thể hiện sự phân tán tổng thiệt hại và tuổi. Tuy nhiên nó sẽ phân hình dạng theo giới tính, tròn là nam và tam giác là nữ. Hơn thế để nổi bật những người có luật sư đại diện thì có thể chọn màu đỏ cho nhóm này.
dat %>% ggplot(aes(x = age, y = los)) +
geom_point(aes(color=atn))+
geom_smooth(aes(color=atn),formula = y~x,method = 'lm')+
labs( title=,x = 'Tuổi', y = 'Thiệt hại')
Từ đồ thị nhận thấy rằng, đường hồi quy của tổng thiệt hại theo tuổi ở nhóm có luật sư nằm phía trên và có độ dốc lớn hơn đường hồi quy nhóm không có luật sư . Vì vậy tổng thiệt hại ở nhóm có luật sư thay đổi lớn hơn. Khi tuổi tăng lên thì tổng thiệt hại ở nhóm có luật sư sẽ tăng hơn so với nhóm không có luật sư
Ngoài ra, ta có thể tách ra theo nhóm luật sư để có thể vẽ đồ thị scatter của tuổi và thiệt hại như bên dưới đây.
dat %>% ggplot(aes(x = age, y = los)) +
geom_point(aes(color=atn))+
geom_smooth(aes(color=atn),formula = y~x,method = 'lm')+
facet_grid(.~atn)+
labs( x = 'Tuổi', y = 'Thiệt hại')
dat %>% ggplot(aes(x = age, y = los)) +
geom_point(aes(color=stn))+
geom_smooth(aes(color=stn),formula = y~x,method = 'lm')+
facet_grid(.~stn)+
labs( x = 'Tuổi', y = 'Thiệt hại')
Mối liên hệ giữa tổng thiệt hại và tuổi ở nhóm người không thắt dây an toàn có sự rời rạc và phân bố không đồng điều. Ngược lại thì ở nhóm người có thắt dây an toàn sự phân bố tập trung, tuy nhiên thì đường hồi quy không có độ dốc lớn điều này cho thấy rằng ở nhóm người có thắt dây an toàn tuổi thay đổi thì tổng thiệt hại không thay đổi nhiều.
dat %>% ggplot(aes(x = age, y = los)) +
geom_point(aes(color=stn))+
geom_smooth(aes(color=stn),formula = y~x,method = 'lm')+
facet_grid(stn~.)+
labs( x = 'Tuổi', y = 'Thiệt hại')
dat %>% ggplot(aes(x = sexn )) +
geom_bar( fill ='red')+
labs(x='Giới tính', y = ' Số người')+
theme_light()
Đồ thị cột thể hiện giới tính nam và nữ. Ta thấy rằng giới tính nữ cao hơn mức 600 người, giới tính nam dưới mức 500 người
Thể hiện trục tung là tỷ lệ phần trăm cho biểu đồ cột về giới tính
dat %>% group_by(sexn) %>%
summarise(n = n()) %>%
mutate(p = scales::percent(n/sum(n), accuracy = 0.01)) %>%
ggplot(aes(x = sexn, y = p)) +
geom_col(fill='skyblue') +
theme_classic() +
labs(x = 'Giới tính', y = 'Tỷ lệ %')
Dựa vào biểu đồ trên cho thấy giới tính nam chiếm tỷ lệ là 43.54% và giới tính nữ chiếm tỷ lệ là 56.46%. Giới tính nữ cao hơn giới tính nam khoảng 12.92%.
dat %>% ggplot(aes(x = sexn, y = after_stat(count))) +
geom_bar(fill = 'blue') +
geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'red', vjust = - .3) +
theme_classic() +
labs(x = 'Giới tính', y = 'Số người')
Em thể hiện tỷ lệ phần trăm ở trên mỗi cột giới tính. Đồ thị có ý nghĩa là có 616 người nữ chiếm tỷ lệ khoảng 56% và 475 nam chiếm tỷ lệ 44%. Vì vậy nữ lớn hơn nam khoảng 141 người và tỷ lệ chêch lệnh là 12%
dat %>% ggplot(aes(x = sexn, y = after_stat(count))) +
geom_bar(fill ='brown') +
geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'black', vjust = - 0.3) +
facet_grid(. ~ atn) +
theme_light() +
labs(x = 'Giới tính', y = 'Số người')
Đồ thị bên trên cho ta biết nữ chiếm khoảng 56,4% trong tổng những người được khảo sát, trong 56,4% đó thì chia ra nữ mà có luật sư đại diện là khoảng 27.3% và nữ mà không có luật sư đại diện là 29.1%. Ngược lại, tỷ lệ nam chiếm khoảng 43.5%, trong đó có 18.2% nam không có luật sư đại diện và 25.3 nam có luật sư đại diện
dat %>% count(marn) %>% mutate(p = scales::percent(n/sum(n), accuracy = 0.01)) %>%
ggplot(aes(x = marn, y = n,fill = marn)) +
geom_col() +
geom_text(aes(label = p),color = 'black ', vjust = 1, size = 3) +
theme_classic() +
labs(x = 'Tình trạng hôn nhân', y = 'Số người')
Đồ thị cột về tình trạng hôn nhân cho ta thấy tỷ lệ người độc thân đạt cao nhất chiếm 48.95% trên tổng số người khảo sát, tỷ lệ người kết hôn khá cao là 47.3%. Ngược lại thì tỷ lệ người góa vợ/chồng là 1.1% thấp nhất trong 4 nhóm và tỷ lệ người ly hôn là 2.66%
Biểu đồ tình trạng hôn nhân được biểu diễn hàng ngang bằng lệnh coord_flip
dat %>% count(marn) %>%
mutate(p = scales::percent(n/sum(n), accuracy = 0.01)) %>%
ggplot(aes(x = marn, y = n,fill = marn)) +
geom_col() +
geom_text(aes(label = p),color = 'red ', hjust =0 , size = 3) +
theme_classic() +
labs(x = 'Tình trạng hôn nhân', y = 'Số người')+
coord_flip()
dat %>% count(sexn, atn) %>% mutate(pt = prop.table(n)) %>%
ggplot(aes(x = sexn, y = n, fill = atn)) +
geom_col(position = 'dodge') +
geom_text(aes(label = scales::percent(pt, accuracy = .01)), position = position_dodge(1), vjust = 3, size = 5) +
labs(x = 'Giới tính', y = 'Số người')
Dựa vào biểu đồ cột ta thấy rằng nhóm nữ có số lượng nhiều hơn nhóm nam. Nhóm nam có luật sư đại diện(25.3%) nhiều hơn nhóm nam không có luật sư đại diện (18.24%), tuy nhiên nữ không có luật sư đại diện(29.15%) lại chiếm cao hơn nữ có luật sư đại diện (27.31%).
dat %>%
count(sexn, atn) %>%
ggplot(aes(x = sexn, y = n, fill = atn)) +
geom_bar(position = "stack", stat = "identity") +
geom_text(aes(label = n), position = position_stack(vjust = 0.5), size = 4) +
labs(x = "Giới tính", y = "Số người")
Biểu đồ cột chồng thể hiện tổng giới tính nữ có 616 người trong đó thì có 298 người có luật sư và 318 người không có luật sư. Giới tính nam là có 475 người, trong đó có 276 người có có luật sư và 199 người không có luật sư. Số nữ không có luật sư lớn hơn số nam không có luật sư rất nhiều (119 người).
dat %>%count(marn, atn) %>%group_by(atn) %>%
mutate(pAtn = n / sum(n)) %>%
ggplot(aes(x = atn, y = n, fill = marn)) +
geom_col() +
geom_text(aes(label = scales::percent(pAtn, accuracy = .01)), position = position_stack(vjust = 0.5), size = 4) +
ylab("Số người") +
xlab("Luật sư đại diện")
Dựa vào đồ thị cột, nhóm người có luật sư chiếm cao hơn nhóm người không có luật sư đại diện. Trong 2 nhóm này đều có tình trạng độc thân và kết hôn chiếm tỷ lệ khá cao, tỷ lệ nhóm người ly hôn và góa ở cả 2 nhóm chiếm tỷ lệ rất thấp
dat %>%group_by(atn) %>%summarise(mean_los = mean(los)) %>%
ggplot(aes(x = atn, y = mean_los, fill = atn)) +
geom_col() +
geom_text(aes(label = round(mean_los, 2)), vjust = -0.5, color = "black") +
ylab("Thiệt hại trung bình") +
xlab("Luật sư") +
scale_fill_manual(values = c("luatsu" = "blue", "kluatsu" = "red"))
Đồ thị bên trên thể hiện tổng thiệt hại trung bình phân theo nhóm luật sư. Tổng thiệt hại trung bình của những người có luật sư là 8.46 (nghìn đô), tuy nhiên tổng thiệt hại của nhóm người không có luật sư là 1.85 (nghìn đô)
dat %>%
group_by(sexn) %>%
summarise(mean_age = mean(age)) %>%
ggplot(aes(x = sexn, y = mean_age, fill = sexn)) +
geom_col() +
geom_text(aes(label = round(mean_age, 2)), vjust = 1, size=5 , color = 'blue') +
ylab("Tuổi trung bình") +
xlab("Giới tính")
Đồ thị cho thấy độ tuổi trung bình của những người khảo sát được phân theo giới tính. Nhóm giới tính nam có độ tuổi trung bình là 32.82 cao hơn tuổi trung bình của giới tính nữ (32.5)
dat %>%
count(marn) %>%
mutate(pct = n / sum(n)) %>%
ggplot(aes(x = "", y = pct, fill = marn)) +
geom_bar(stat = "identity") +
coord_polar("y") +
geom_text(aes(label = scales::percent(pct)), position = position_stack(vjust = 0.5)) +
theme_void() +
labs(title = "Biểu đồ tình trạng hôn nhân")
Biểu đồ tròn thể hiện tình trạng hôn nhân của những người được khảo sát. Dựa vào đồ thị nhận thấy trong tỷ lệ người độc thân là 48.9% chiếm cao nhất trong tổng số, kế tiếp tỷ lệ khá cao đó là những người đã kết hôn chiếm 47.3%. Tỷ lệ người góa vợ/ chồng chiếm thấp nhất là 1.1%
Tạo một biến tuổi mới trong đó chia ra làm 3 nhóm tuổi dưới 30, từ 30-50 tuổi và trên 50 tuổi. Sau đó vẽ biểu đồ dựa vào biến tuổi mới này
dat <- dat %>% mutate(agen = cut(age, breaks = c(-1, 30, 50, 95), labels = c("Dưới 30", "30-50", "Trên 50")))
dat %>% count(agen) %>% mutate(per=n/sum(n)) %>%
ggplot(aes(x="",y=per,fill=agen))+
geom_bar(stat="identity",width=1 )+
coord_polar("y", start = 0)+
geom_text(aes(label=scales::percent(per)),position=position_stack(vjust=0.5),color='white',size=5)+
labs(fill = "Nhóm Tuổi", title="BIỂU ĐỒ TRÒN NHÓM TUỔI") +
theme_void()
Biểu đồ tròn phía trên thể hiện tỷ lệ phần trăm của 3 nhóm tuổi, trong đó những người dưới 30 tuổi chiếm 49% và những người trên 50 chiếm thấp nhất trên tổng số chiếm khoảng 14%.
dat %>%
count(stn) %>%
ggplot(aes(x = "", y = n, fill = stn)) +
geom_bar(stat = "identity", width = 1) +
coord_polar("y", start = 0) +
geom_text(aes(label = n),
position = position_stack(vjust = 0.5),
color = "white",
size = 4) +
labs(fill = "Tình trạng thắt dây an toàn", title="Biều đồ về tình trạng thắt dây") +
theme_void()
Trong biểu đồ trên thì nhóm người thắt dây chiếm phần lớn là 1071 người (khoảng 98.2%)và nhóm người không thắt dây là 20 người (khoảng 1.8%)
đồ thị đường biểu diễn mối quan hệ của tuổi và giới tính được phân theo giới tính là hai đường khác nhau. Nhìn chung cả hai đường đều không có sự khác biệt rõ rêt cho thấy tuổi ở cả hai giới tính không ảnh hưởng nhiều đến thiệt hại. Tuy nhiên đường biểu diễn về sự thay đổi thiệt hại theo tuổi ở nhóm nữ có sự biến động hơn.
dat %>%
ggplot(aes(x = age, y = los, color = sexn)) +
geom_line() +
labs(x = 'Tuổi', y = 'Thiệt hại', color = 'Giới tính')
Biểu đồ hộp bên dưới giúp so sánh sự biến động của “Thiệt hại” giữa các nhóm “tình trạng luật sư đại diện” khác nhau. Ta thấy rằng ở nhóm có luật sư đại diện thì sự biến động có sự trải dài phía trên cho thấy có luật sư đại diện sẽ ảnh hưởng đến thiệt hại tăng lên. Còn không có luật sư đại diện thì không ảnh hưởng nhiều đến thiệt hại
dat %>%
ggplot(aes(x = atn , y = los)) +
geom_boxplot(fill = 'lightblue') +
labs(x = 'tình trạng luật sư đại diện', y = 'Thiệt hại')
Biểu đồ violin plot này cho thấy phân phối của biến “Thiệt hại” dựa trên giới tính. Phân phối ở hai giới tính tương đổi giống nhau, tuy nhiên đường trắng ở giữa violin biến nữ dài hơn so với violin biến nam, điều này có thể chỉ ra rằng phân phối của biến nữ có độ biến động lớn hơn so với biến nam.
dat %>%
ggplot(aes(x = sexn , y = los, fill = sexn )) +
geom_violin() +
labs(x = 'Giới tính', y = 'Thiệt hại')
Dữ liệu để phân tích cho tuần 3
Dataset: gapminder - Package: gapminder
Bộ dữ liệu “gapminder” cung cấp thông tin về tuổi thọ trung bình, dân số và GDP per capita của các quốc gia trên toàn cầu từ năm 1952 đến 2007. Nó giúp ta nắm bắt được sự thay đổi và sự phát triển của các quốc gia theo thời gian và vùng lục địa.
Gồm 1704 quan sát và 6 biến trong đó :
country (ct): Tên quốc gia.
continent (cn): Lục địa nơi quốc gia thuộc về. Có 5 giá trị: Africa, Americas, Asia, Europe, và Oceania.
year (y): Năm ghi nhận dữ liệu.
lifeExp (l): Tuổi thọ trung bình của dân số trong quốc gia, tính bằng đơn vị năm.
population (p): Dân số của quốc gia trong năm cụ thể.
gdpPercap (g): GDP (Gross Domestic Product) per capita của quốc gia trong năm cụ thể.
Đầu tiên gọi package gapminder bằng lệnh library
Gọi dataset gapminder để thực hiện các thao tác
library(gapminder)
data(gapminder)
library(tidyverse)
Gán data gapminder vào biến có tên ga. Sau đó đặt tên lần lượt cho 6 biến trong bộ dữ liệu là “ct”,“cn”,“y”,“l”,“p”,“g” bằng lệnh names
ga <- gapminder
names(ga) <- c("ct","cn","y","l","p","g")
Dùng lệnh summary để nhìn tổng quan dữ liệu
summary(ga)
## ct cn y l
## Afghanistan: 12 Africa :624 Min. :1952 Min. :23.60
## Albania : 12 Americas:300 1st Qu.:1966 1st Qu.:48.20
## Algeria : 12 Asia :396 Median :1980 Median :60.71
## Angola : 12 Europe :360 Mean :1980 Mean :59.47
## Argentina : 12 Oceania : 24 3rd Qu.:1993 3rd Qu.:70.85
## Australia : 12 Max. :2007 Max. :82.60
## (Other) :1632
## p g
## Min. :6.001e+04 Min. : 241.2
## 1st Qu.:2.794e+06 1st Qu.: 1202.1
## Median :7.024e+06 Median : 3531.8
## Mean :2.960e+07 Mean : 7215.3
## 3rd Qu.:1.959e+07 3rd Qu.: 9325.5
## Max. :1.319e+09 Max. :113523.1
##
Để xem qua 6 dòng đầu và 6 dòng cuối của dữ liệu bao gồm các thông tin về đất nước, châu lục, năm, tuổi thọ trung bình, dân số và gdp của quốc gia ta sử dụng lệnh head và tail
head(ga)
## # A tibble: 6 × 6
## ct cn y l p g
## <fct> <fct> <int> <dbl> <int> <dbl>
## 1 Afghanistan Asia 1952 28.8 8425333 779.
## 2 Afghanistan Asia 1957 30.3 9240934 821.
## 3 Afghanistan Asia 1962 32.0 10267083 853.
## 4 Afghanistan Asia 1967 34.0 11537966 836.
## 5 Afghanistan Asia 1972 36.1 13079460 740.
## 6 Afghanistan Asia 1977 38.4 14880372 786.
tail(ga)
## # A tibble: 6 × 6
## ct cn y l p g
## <fct> <fct> <int> <dbl> <int> <dbl>
## 1 Zimbabwe Africa 1982 60.4 7636524 789.
## 2 Zimbabwe Africa 1987 62.4 9216418 706.
## 3 Zimbabwe Africa 1992 60.4 10704340 693.
## 4 Zimbabwe Africa 1997 46.8 11404948 792.
## 5 Zimbabwe Africa 2002 40.0 11926563 672.
## 6 Zimbabwe Africa 2007 43.5 12311143 470.
Trước khi thực hiện phân tích bộ dữ liệu thì cũng cần xem qua cấu trúc của nó. Ta dùng lệnh str
str(ga)
## tibble [1,704 × 6] (S3: tbl_df/tbl/data.frame)
## $ ct: Factor w/ 142 levels "Afghanistan",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ cn: Factor w/ 5 levels "Africa","Americas",..: 3 3 3 3 3 3 3 3 3 3 ...
## $ y : int [1:1704] 1952 1957 1962 1967 1972 1977 1982 1987 1992 1997 ...
## $ l : num [1:1704] 28.8 30.3 32 34 36.1 ...
## $ p : int [1:1704] 8425333 9240934 10267083 11537966 13079460 14880372 12881816 13867957 16317921 22227415 ...
## $ g : num [1:1704] 779 821 853 836 740 ...
Để nhóm dữ liệu từ biến ga theo châu lục(cn) em dùng lệnh group_by, tiếp theo em dùng hàm summarise để thực hiện tổ hợp các phép tính sau khi nhóm cụ thể là phép tính tổng cho biến gdp(g ). Bảng kết quả sẽ gán vào total để thực hiện các thao tác khác.
total<- ga %>% group_by(cn) %>%
summarise(sum=sum(g))
total
## # A tibble: 5 × 2
## cn sum
## <fct> <dbl>
## 1 Africa 1368903.
## 2 Americas 2140833.
## 3 Asia 3129252.
## 4 Europe 5209011.
## 5 Oceania 446919.
Kết quả từ bảng trên cho thấy tổng GDP của châu Âu là lớn nhất 5209011.2 đô và ngược lại tổng GDP của châu đại dương là nhỏ nhất 446918.6 đô.
Để vẽ biểu đồ cho bảng kết quả trên em sử dụng lệnh ggplot. Trong đó,trục x là các châu lục, trục y là tổng GDP vừa được tính
library(ggplot2)
ggplot(total,aes(x=cn,y=sum,fill = cn) )+
geom_col() +
labs(x = "chauluc", y = "giatri", fill = "chauluc") +
theme_minimal()
Tương tự, tính trung bình gdp của tất cả các quốc gia được nhóm theo năm sau đó gán vào biến m
m<- ga %>% group_by(y) %>%
summarise(mean=mean(g))
m
## # A tibble: 12 × 2
## y mean
## <int> <dbl>
## 1 1952 3725.
## 2 1957 4299.
## 3 1962 4726.
## 4 1967 5484.
## 5 1972 6770.
## 6 1977 7313.
## 7 1982 7519.
## 8 1987 7901.
## 9 1992 8159.
## 10 1997 9090.
## 11 2002 9918.
## 12 2007 11680.
Sau đó, em vẽ đồ thị cho bảng kết quả ở trên
ggplot(m,aes(x=y,y=mean,fill = y) )+
geom_col() +
labs(x = "Năm ", y = "Giá trị", fill = "Năm") +
theme_minimal()
Từ bảng kết quả và đồ thị có thể nhận thấy rằng trung bình GDP của tất cả các quốc gia có sự tăng lên qua các năm. Năm 1952 trung bình GDP là 3725.276 đô tăng dần cho đến năm 2007 là 11680.072 đô
Nhóm bộ dữ liệu theo biến châu lục, năm và thực hiện tổ hợp các phép tính tổng, trung bình, độ lệnh chuẩn cho gdp. Kết quả vừa thực hiện được gán vào biến g1
g1 <- ga %>% group_by(cn,y) %>%
summarise(sgdp=sum(g),mgdp= mean(g),sdgdp= sd(g),.groups = 'drop')
head(g1)
## # A tibble: 6 × 5
## cn y sgdp mgdp sdgdp
## <fct> <int> <dbl> <dbl> <dbl>
## 1 Africa 1952 65134. 1253. 983.
## 2 Africa 1957 72032. 1385. 1135.
## 3 Africa 1962 83100. 1598. 1462.
## 4 Africa 1967 106619. 2050. 2848.
## 5 Africa 1972 121660. 2340. 3287.
## 6 Africa 1977 134469. 2586. 4142.
Lập bảng độ tuổi trung bình của các quốc gia theo năm và được phân làm 3 nhóm tuổi sau đó gán vào các tên từ 23-35 (tre); 35-50(trung); 50-83 (lon).
t <- table(cut(ga$l, breaks = c(23,35,50,83 ),labels = c("tre","trung","lon")),ga$y)
t
##
## 1952 1957 1962 1967 1972 1977 1982 1987 1992 1997 2002 2007
## tre 14 10 5 2 0 1 0 0 1 0 0 0
## trung 68 66 65 51 44 33 27 21 20 21 23 19
## lon 60 66 72 89 98 108 115 121 121 121 119 123
prop.table(t, margin = 2)
##
## 1952 1957 1962 1967 1972 1977
## tre 0.098591549 0.070422535 0.035211268 0.014084507 0.000000000 0.007042254
## trung 0.478873239 0.464788732 0.457746479 0.359154930 0.309859155 0.232394366
## lon 0.422535211 0.464788732 0.507042254 0.626760563 0.690140845 0.760563380
##
## 1982 1987 1992 1997 2002 2007
## tre 0.000000000 0.000000000 0.007042254 0.000000000 0.000000000 0.000000000
## trung 0.190140845 0.147887324 0.140845070 0.147887324 0.161971831 0.133802817
## lon 0.809859155 0.852112676 0.852112676 0.852112676 0.838028169 0.866197183
Dựa vào bảng trên ta nhận thấy đa số các quốc đều thuộc nhóm lớn tuổi (50 tuổi đến 83 tuổi). Trong năm 1952 có 14 quốc gia có độ tuổi thuộc nhóm trẻ khoảng 9%, có 60 nước thuộc nhóm lớn tuổi khoảng 42% và 68 quốc gia thuộc nhóm trung chiếm khoảng 47%. Tuy nhiên thì đến năm 2007 số quốc gia thuộc nhóm tuổi trung giảm xuống chỉ còn 19 (13.4%), nhóm trẻ tuổi giảm dần qua các năm đến 2007 chỉ còn 0 quốc giá khoảng 0%, ngược lại thì số quốc gia thhuộc nhóm lớn tuổi là 123(86.7%).
Trước tiên, em chia GDP thành các khoảng từ 0-3000; 3000-7000 ; 7000-12000 và lớn hơn 12000. Gán các khoảng này tương ứng với các tên “thap”,“trung”,“cao”,“ratcao”. Kết quả tạo được một cột gdpn và thêm vào data tên ga. Kế tiếp em lập bảng tần số dựa vào kết quả trên.
ga <- mutate(ga,gdpn = cut(ga$g, breaks = c (0,3000,7000,12000,Inf), labels = c("thap","trung","cao","ratcao")))
t1 <- table(ga$gdpn,ga$y)
t1
##
## 1952 1957 1962 1967 1972 1977 1982 1987 1992 1997 2002 2007
## thap 89 84 78 75 66 57 57 59 59 56 53 49
## trung 36 37 36 31 28 35 30 29 29 27 30 24
## cao 14 16 15 17 22 19 19 18 19 23 21 23
## ratcao 3 5 13 19 26 31 36 36 35 36 38 46
prop.table(t1 , margin = 2)
##
## 1952 1957 1962 1967 1972 1977
## thap 0.62676056 0.59154930 0.54929577 0.52816901 0.46478873 0.40140845
## trung 0.25352113 0.26056338 0.25352113 0.21830986 0.19718310 0.24647887
## cao 0.09859155 0.11267606 0.10563380 0.11971831 0.15492958 0.13380282
## ratcao 0.02112676 0.03521127 0.09154930 0.13380282 0.18309859 0.21830986
##
## 1982 1987 1992 1997 2002 2007
## thap 0.40140845 0.41549296 0.41549296 0.39436620 0.37323944 0.34507042
## trung 0.21126761 0.20422535 0.20422535 0.19014085 0.21126761 0.16901408
## cao 0.13380282 0.12676056 0.13380282 0.16197183 0.14788732 0.16197183
## ratcao 0.25352113 0.25352113 0.24647887 0.25352113 0.26760563 0.32394366
Số quốc gia có gdp thuộc nhóm thấp và trung có xu hướng giảm đi qua các năm, ở năm 1952 có 89 quốc gia thuộc nhóm gdp thấp khoảng 62.7% tuy nhiên thì đến năm 2007 nhóm này chỉ còn 49 quốc gia và chiếm khoảng 34.5%. Ngược lại thì số quốc gia thuộc nhóm cao và rất cao có sự tăng lên qua các năm, cụ thể trong năm 1952 chỉ có 3 quốc gia thuộc nhóm rất cao chiếm khoảng 2% nhưng đến năm 2007 có 46 quốc gia thuộc nhóm rất cao và chiếm khoảng 32.3%
hq <- lm(g~l,ga )
summary(hq)
##
## Call:
## lm(formula = g ~ l, data = ga)
##
## Residuals:
## Min 1Q Median 3Q Max
## -11483 -4539 -1223 2482 106950
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -19277.25 914.09 -21.09 <2e-16 ***
## l 445.44 15.02 29.66 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 8006 on 1702 degrees of freedom
## Multiple R-squared: 0.3407, Adjusted R-squared: 0.3403
## F-statistic: 879.6 on 1 and 1702 DF, p-value: < 2.2e-16
Kết quả hồi qui của biến gdp(g) theo biến tuổi thọ(l) cho chúng ta thấy rằng: giá trị p-value của hệ số Intercept và g đều rất nhỏ (p < 2e-16), cho thấy rằng cả hai hệ số này có ý nghĩa thống kê đáng kể. Giá trị R-squared là 0.3407 và Adjusted R-squared là 0.3403. Ý nghĩa là mô hình giải thích được khoảng 34% sự thay đổi của gdp. Giá trị p-value của F-statistic là 2.2e-16 nhỏ hơn các mức ý nghĩa cho thấy mô hình này phù hợp để phân tích mối liên hệ giữa hai biến tuổi thọ và gdp. Tuy nhiên thì hệ số R-squared không cao nên mô hình chưa giải thích hết sự thay đổi của biến phụ thuộc.
hq2 <- lm(p~g,ga )
summary(hq2)
##
## Call:
## lm(formula = p ~ g, data = ga)
##
## Residuals:
## Min 1Q Median 3Q Max
## -31291781 -27331437 -22315453 -10091438 1288459870
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 31590402.5 3187212.3 9.912 <2e-16 ***
## g -275.7 261.0 -1.056 0.291
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 106200000 on 1702 degrees of freedom
## Multiple R-squared: 0.0006553, Adjusted R-squared: 6.818e-05
## F-statistic: 1.116 on 1 and 1702 DF, p-value: 0.2909
Trong kết quả hồi quy của biến dân số theo gdp thì giá trị p-value cho F-statistic là 0.2909 cao hơn mức ý nghĩa thông thường là 0.05 cho nên mô hình chưa phù hợp. Hơn thế, giá trị R-squared là 0.0006553 cho thấy sự thay đổi của dân số chỉ giải thích một phần rất nhỏ sự thay đổi của gdp
Dựa vào dữ liệu được tính GDP theo năm và châu lục trong biến g1 ở phần tính GDP. Em sử dụng lệnh pivot_longer để chuyển sang dữ liệu dài đưa các tên cột sgdp(tổng gdp), mgdp(trung bình gdp), sdgdp(sai số chuẩn) về cột “cs”. Giá trị của các cột cũ sẽ đưa vào cột mới là “vl”. Dữ liệu mới được đặt tên là g2
g2 <- pivot_longer(g1, cols=c(sgdp,mgdp,sdgdp),names_to = "cs",values_to = "vl")
g2
## # A tibble: 180 × 4
## cn y cs vl
## <fct> <int> <chr> <dbl>
## 1 Africa 1952 sgdp 65134.
## 2 Africa 1952 mgdp 1253.
## 3 Africa 1952 sdgdp 983.
## 4 Africa 1957 sgdp 72032.
## 5 Africa 1957 mgdp 1385.
## 6 Africa 1957 sdgdp 1135.
## 7 Africa 1962 sgdp 83100.
## 8 Africa 1962 mgdp 1598.
## 9 Africa 1962 sdgdp 1462.
## 10 Africa 1967 sgdp 106619.
## # ℹ 170 more rows
Tương tự với bộ dự liệu ban đầu ga ta có thể chọn một số cột cụ thể để biến đổi bằng lệnh select, các cột để chuyển sang dữ liệu dài là tuổi thọ, dân số, gdp được đặt vào cột có tên là “ind” và giá trị nằm trong cột tên là “val”.
gap <- ga %>% select(ct,y,l,p,g) %>% pivot_longer(cols = c(l,p,g), names_to = "ind",values_to = "val")
gap
## # A tibble: 5,112 × 4
## ct y ind val
## <fct> <int> <chr> <dbl>
## 1 Afghanistan 1952 l 28.8
## 2 Afghanistan 1952 p 8425333
## 3 Afghanistan 1952 g 779.
## 4 Afghanistan 1957 l 30.3
## 5 Afghanistan 1957 p 9240934
## 6 Afghanistan 1957 g 821.
## 7 Afghanistan 1962 l 32.0
## 8 Afghanistan 1962 p 10267083
## 9 Afghanistan 1962 g 853.
## 10 Afghanistan 1967 l 34.0
## # ℹ 5,102 more rows
Từ bảng dữ liệu ta thấy quốc gia Afghanistan vào năm 1952 sẽ có tuổi thọ trung bình là 28.8, dân số là 8425333 người và gdppercap là 779.4453 đô
Chuyển dữ liệu từ dạng dài sang dạng rộng ta sử dụng lệnh pivot_wider, bộ dữ liệu được chọn là gap, trong đó tên cột chứa các giá trị tên biến mới là “ind” và tên cột chứa các giá trị biến mới là “val”
gap <- gap %>%pivot_wider(names_from = ind , values_from = val )
gap
## # A tibble: 1,704 × 5
## ct y l p g
## <fct> <int> <dbl> <dbl> <dbl>
## 1 Afghanistan 1952 28.8 8425333 779.
## 2 Afghanistan 1957 30.3 9240934 821.
## 3 Afghanistan 1962 32.0 10267083 853.
## 4 Afghanistan 1967 34.0 11537966 836.
## 5 Afghanistan 1972 36.1 13079460 740.
## 6 Afghanistan 1977 38.4 14880372 786.
## 7 Afghanistan 1982 39.9 12881816 978.
## 8 Afghanistan 1987 40.8 13867957 852.
## 9 Afghanistan 1992 41.7 16317921 649.
## 10 Afghanistan 1997 41.8 22227415 635.
## # ℹ 1,694 more rows
Từ dữ liệu ban đầu, em tính tổng gdp theo châu lục và năm như các làm ở phần trước đó. Sau đó, chuyển dữ liệu tổng gdp từ dạng rộng sang dạng dài theo năm. Ta sẽ được bảng tổng gdp mới như dưới đây.
ganew <- ga %>% group_by(cn,y) %>% summarise(sgdp=sum(g),.groups = 'drop')%>%
pivot_wider(names_from = y , values_from = sgdp )
ganew
## # A tibble: 5 × 13
## cn `1952` `1957` `1962` `1967` `1972` `1977` `1982` `1987` `1992` `1997`
## <fct> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Africa 6.51e4 7.20e4 8.31e4 1.07e5 1.22e5 1.34e5 1.29e5 1.19e5 1.19e5 1.24e5
## 2 Americas 1.02e5 1.15e5 1.23e5 1.42e5 1.62e5 1.84e5 1.88e5 1.95e5 2.01e5 2.22e5
## 3 Asia 1.71e5 1.91e5 1.89e5 1.97e5 2.70e5 2.57e5 2.45e5 2.51e5 2.85e5 3.25e5
## 4 Europe 1.70e5 2.09e5 2.51e5 3.04e5 3.74e5 4.29e5 4.69e5 5.16e5 5.12e5 5.72e5
## 5 Oceania 2.06e4 2.32e4 2.54e4 2.90e4 3.28e4 3.46e4 3.71e4 4.09e4 4.18e4 4.80e4
## # ℹ 2 more variables: `2002` <dbl>, `2007` <dbl>
Ngoài ra, từ cột năm ban đầu có thể tạo thêm hai cột mới là century, year bằng lệnh mutate. Trong đó, cột century sẽ lấy 2 giá trị đầu tiền trong năm và cột year lấy 2 giá trị cuối.
g3 <- ga %>% mutate(century= substr(y,1,2), year= substr(y,3,4))
print(g3 )
## # A tibble: 1,704 × 9
## ct cn y l p g gdpn century year
## <fct> <fct> <int> <dbl> <int> <dbl> <fct> <chr> <chr>
## 1 Afghanistan Asia 1952 28.8 8425333 779. thap 19 52
## 2 Afghanistan Asia 1957 30.3 9240934 821. thap 19 57
## 3 Afghanistan Asia 1962 32.0 10267083 853. thap 19 62
## 4 Afghanistan Asia 1967 34.0 11537966 836. thap 19 67
## 5 Afghanistan Asia 1972 36.1 13079460 740. thap 19 72
## 6 Afghanistan Asia 1977 38.4 14880372 786. thap 19 77
## 7 Afghanistan Asia 1982 39.9 12881816 978. thap 19 82
## 8 Afghanistan Asia 1987 40.8 13867957 852. thap 19 87
## 9 Afghanistan Asia 1992 41.7 16317921 649. thap 19 92
## 10 Afghanistan Asia 1997 41.8 22227415 635. thap 19 97
## # ℹ 1,694 more rows
g4 <- gapminder %>% group_by(year,continent) %>% summarise(tgdp = sum(gdpPercap),.groups = 'drop')
ggplot(data = g4, aes(x = year ,y = tgdp,color= continent)) + geom_line()+ labs(x= "Year", y="Tổng GDP", color = "Châu lục" )+
theme_minimal()
Đồ thị cho thấy sự tăng trưởng tổng gdp của châu Âu mạnh mẽ hơn các châu lục khác trong giai đoạn 1952 đến 2007. Trong khi đó, Châu Đại Dương có tổng GDP thấp hơn các châu lục còn lại và sự tăng trưởng tổng GDP qua các năm còn khá thấp so với các châu lục khác.
`
g6 <- gapminder %>% group_by(year) %>% summarise(tpop= sum(pop))
ggplot(data = g6,aes(x=year))+
geom_col(aes(y=tpop),fill= "grey")+
geom_line(aes(y=tpop,group= 1),color = "red")+
labs(x= "Năm", y = "Tổng dân số", fill= "Tổng dân số" , color= "Tổng dân số")+
theme_minimal()
Tổng dân số của các quốc gia tăng dần qua các năm. Năm 1952 tổng dân số có khoảng 2.4 tỷ người tăng lên khoảng 6.2 tỷ người vào năm 2007.
c <- cor(ga[, c("p", "g", "l")])
print(c)
## p g l
## p 1.00000000 -0.02559958 0.06495537
## g -0.02559958 1.00000000 0.58370622
## l 0.06495537 0.58370622 1.00000000
library(corrplot)
corrplot(c, method = "square")
Tạo bảng ma trận tương quan giữa các biến l,p,g bằng hàm cor. Sau đó em vẽ được đồ thị ma trận tương quan theo phương pháp square. Hình vuông càng lớn là có tương quan càng mạnh, màu xanh chỉ tương quan là dương còn màu đỏ chỉ tương quan là âm. Có thể thấy tương quan giữa biến tuổi thọ và gdp là dương và khá cao (0.58), tương quan giữa biến dân số và biến gdp là tương quan âm và mối tương quan này rất thấp (-0.026).
vndat <- subset(ga, ct == "Vietnam")
ggplot(vndat, aes(x = y, y = l)) +
geom_line() +
labs(x = "Năm", y = "Tuổi", title = "Sự thay đổi tuổi của Việt Nam")
Bên cạnh đó, ta cũng có thể lọc dữ liệu của Việt Nam bằng lệnh subset sau đó vẽ dữ liệu đường cho bộ dữ liệu mới. Từ đồ thị trên ta thấy rằng tuổi thọ trung bình của Việt Nam có sự gia tăng nhanh, ở năm 1952 tuổi thọ trung bình là khoảng 42 tuổi nhưng đến năm 2007 tuổi thọ trung bình là 74 tuổi.
ggplot(ga,aes(x= l, y= g, color=cn))+
geom_point()+
geom_smooth(formula = y~x, method = lm, color="green")+
facet_grid(.~cn)+
labs( x="Tuổi ", y="GDP")
-Tương tự ở tuần 1, ta sẽ gọi dữ liệu AutoBi từ package insuranceData
-Sau đó sẽ gán dataset AutoBi vào dat và sử dụng lệnh na.omit để loại bỏ các dữ liệu na
-Sử dụng lệnh names để đặt tên cho 8 biến trong bộ dữ liệu dat
library(insuranceData)
data("AutoBi")
dat <- AutoBi
dat <- na.omit(dat)
names(dat) <- c("case","att","sex","mar","ins","seat","age","los")
-Chúng ta có thể lọc những người đang có tình trạng ly thân bằng cách trong cột MARITAL ( được đặt tên là mar) ta chọn những giá trị là 4
-Kết quả từ câu lệnh sẽ được gán vào mr
-Dữ liệu trong mr sẽ cho thấy thông tin của những người đang có tình trạng ly thân (29 người chiếm khoảng 2.6% tổng số)
mr <- dat[dat$mar == 4,]
mr
## case att sex mar ins seat age los
## 5 96 2 1 4 2 1 30 0.138
## 20 412 1 2 4 2 1 38 4.754
## 23 551 1 1 4 1 1 38 26.262
## 31 640 2 2 4 2 1 26 3.994
## 51 1104 1 2 4 2 1 29 3.777
## 94 2092 1 1 4 2 1 32 13.028
## 106 2314 1 1 4 2 1 43 14.485
## 139 3298 2 2 4 2 1 62 0.535
## 172 4066 1 2 4 2 1 42 4.840
## 265 6869 1 1 4 2 1 50 1.675
## 280 7217 1 1 4 2 1 47 10.250
## 375 9524 1 2 4 2 1 46 8.802
## 411 10479 1 2 4 2 1 45 49.025
## 544 14147 1 1 4 2 1 44 3.666
## 565 14614 2 2 4 2 1 37 0.500
## 654 17098 1 1 4 2 1 34 6.570
## 675 17707 1 2 4 2 1 33 15.467
## 701 18233 1 2 4 2 1 42 1.802
## 702 18255 1 1 4 2 1 49 1.330
## 779 19999 2 2 4 2 1 38 0.255
## 899 23180 2 2 4 2 1 70 4.637
## 904 23308 2 1 4 2 1 44 3.434
## 1041 26624 2 2 4 2 1 45 2.903
## 1057 26989 2 1 4 2 1 49 0.195
## 1061 27248 1 2 4 2 1 63 4.504
## 1120 28791 2 2 4 2 1 61 0.300
## 1145 29395 2 2 4 2 1 39 4.162
## 1219 31413 2 2 4 2 1 40 1.835
## 1313 33662 1 2 4 2 1 45 24.884
-Ngoài ra, ta cũng có thể lập một bảng về tình trạng hôn nhân bằng lệnh table và biến được chọn là mar. Trong biến này giá trị 1 là đã kết hôn, giá trị 2 là độc thân, giá trị 3 nếu góa vợ/chồng và giá trị 4 nếu đã ly thân/ly dị
-Để có được bảng tần suất thì ta chia cho tổng số quan sát
-Kết quả cho chúng ta thấy:
table(dat$mar)
##
## 1 2 3 4
## 516 534 12 29
table(dat$mar)/1091*100
##
## 1 2 3 4
## 47.296059 48.945921 1.099908 2.658112
-Kế tiếp ta tạo thêm một cột dữ liệu cho dat dựa trên phân tổ độ tuổi bằng lệnh cut. Trong đó sẽ chia làm 3 khoảng tuổi là dưới 18 tuổi, từ 18 đến 65 tuổi và trên 65 tuổi. Tham số labels được dùng để đặt tên cho các khoảng
-Sau đó ta có thể lập bảng cho biến tuổi mới bằng lệnh table
-Bảng này cho ta biết rằng:
dat$agen<- cut(dat$age, breaks = c(-1,18,65,95), labels = c("chualaodong","tuoilaodong","nghihuu") )
table(dat$agen)
##
## chualaodong tuoilaodong nghihuu
## 247 795 49
table(dat$agen)/1091
##
## chualaodong tuoilaodong nghihuu
## 0.22639780 0.72868928 0.04491292
-Để nhìn tổng quan data frame chúng ta có thể sử dụng lệnh summary để biết các thông tin về trung bình, min, max, trung vị, các tứ phân vị của các biến
summary(dat)
## case att sex mar
## Min. : 13 Min. :1.000 Min. :1.000 Min. :1.000
## 1st Qu.: 8431 1st Qu.:1.000 1st Qu.:1.000 1st Qu.:1.000
## Median :17550 Median :1.000 Median :2.000 Median :2.000
## Mean :17250 Mean :1.474 Mean :1.565 Mean :1.591
## 3rd Qu.:26051 3rd Qu.:2.000 3rd Qu.:2.000 3rd Qu.:2.000
## Max. :34253 Max. :2.000 Max. :2.000 Max. :4.000
## ins seat age los
## Min. :1.000 Min. :1.000 Min. : 0.00 Min. : 0.005
## 1st Qu.:2.000 1st Qu.:1.000 1st Qu.:19.00 1st Qu.: 0.753
## Median :2.000 Median :1.000 Median :31.00 Median : 2.435
## Mean :1.904 Mean :1.018 Mean :32.64 Mean : 5.326
## 3rd Qu.:2.000 3rd Qu.:1.000 3rd Qu.:43.00 3rd Qu.: 4.189
## Max. :2.000 Max. :2.000 Max. :95.00 Max. :273.604
## agen
## chualaodong:247
## tuoilaodong:795
## nghihuu : 49
##
##
##
-Bên cạnh đó ta cũng có thể sử dụng các lệnh thống kê cơ bản để phân tích về biến tổng thiệt hại (los)
-Kết quả bên dưới có ý nghĩa:
mean(dat$los)
## [1] 5.326176
median(dat$los)
## [1] 2.435
sd(dat$los)
## [1] 16.17456
quantile(dat$los, 0.75)
## 75%
## 4.1885
-chúng ta tạo biểu đồ histogram của biến los để xem phân bố dữ liệu, ta dùng lênh hist
hist(dat$los )
-Tiếp theo, chúng ta có thể thực hiện các phép tính tổng hợp dữ liệu của biến loss theo các biến ATTORNEY(att) bằng lệnh aggregate. Cụ thể, ta tổng hợp biến los theo biến att trong dataframe dat và tính trung bình của los với mỗi giá trị của biến att
-Ý nghĩa bảng kết quả là :
Những người có luật sự đại diện thì trung bình tổng thiệt hại là 8.6 nghìn đô
Những người không có luật sư đại điện thì có trung bình tổng thiệt hại là 1.85 nghìn đô
aggregate(los ~ att, dat, FUN= mean)
## att los
## 1 1 8.456934
## 2 2 1.850248
-Kế tiếp, ta có thể tạo một biến mới tên là s để gán tên cho các giá trị 1 là thắt dây an toàn và 2 không có thắt dây an toàn từ biến ban đầu seat bằng lệnh factor
-Sau đó, ta dùng lệnh “group_by” để phân nhóm dữ liệu theo tình trạng cài dây an toàn. Dùng lệnh summarise để tính trung bình và tổng của thiệt hại dựa vào tình trạng đeo dây an toàn
ở nhóm người có cài dây an toàn thì trung bình thiệt hại là 5.03 nghìn đô thấp hơn trung bình nhóm người không có đeo dây an toàn (20.9 nghìn đô ).
Tuy nhiên thì tổng thiệt hại của người có đeo dây an toàn lại lớn hơn những người không có đeo dây (lớn hơn 4971.402 nghìn đô)
library(tidyverse)
dat$s <- factor(dat$seat, labels = c("codaydeo","khongcodaydeo "))
group_by(dat,s) %>% summarise(mean=mean(los),sum=sum(los))
## # A tibble: 2 × 3
## s mean sum
## <fct> <dbl> <dbl>
## 1 "codaydeo" 5.03 5391.
## 2 "khongcodaydeo " 21.0 420.
-Ngoài ra để có thể phân biệt người nào thu thập dữ liệu và ghép chúng lại thành một cột thì chúng ta có dùng cách như sau.
Giả sử 10 số liệu hồ sơ đầu tiên do người A thu nhập. Ta lấy từ cột case ban đầu gán vào c1, sau đó tạo dataframe tên là case1 có 2 biến. Biến hoso là mã số hồ sơ thu thập và biến nguoithuthap có tên là người A
Tương tư, ta lấy 10 mã hồ sơ tiếp theo gán vào c2 và từ đó tạo data frame case2, người thu thập là người B
Cuối cùng, ta dùng lệnh rbind để nối 2 data trên thành một data mới có tên casenew
c <- dat$case
c1 <- c[1:10]
c2 <- c[20:30]
case1 <- data.frame(hoso = c1,nguoithuthap="A")
case2 <- data.frame(hoso= c2, nguoithuthap="B")
casenew <- rbind(case1,case2)
casenew
## hoso nguoithuthap
## 1 13 A
## 2 66 A
## 3 71 A
## 4 96 A
## 5 97 A
## 6 120 A
## 7 136 A
## 8 152 A
## 9 162 A
## 10 248 A
## 11 551 B
## 12 581 B
## 13 608 B
## 14 613 B
## 15 616 B
## 16 617 B
## 17 640 B
## 18 685 B
## 19 700 B
## 20 721 B
## 21 766 B
Tập dữ liệu “Automobile Bodily Injury Claims” được thu thập từ Insurance Research Council (IRC). Dữ liệu này thu thập vào năm 2002 và bao gồm thông tin về người yêu cầu bồi thường, đại diện luật sư và thiệt hại kinh tế (LOSS, tính bằng nghìn đô), cùng với các biến khác. Trong tập dữ liệu này, chúng ta xem xét một mẫu gồm n = 1.340 yêu cầu bồi thường từ một bang duy nhất
Dữ liệu trên có 8 biến bao gồm :
CASENUM: Số hồ sơ để xác định yêu cầu bồi thường, là một số nguyên.
ATTORNEY: Cho biết người yêu cầu bồi thường có được đại diện bởi một luật sư hay không. Giá trị 1 nếu có đại diện luật sư và giá trị 2 nếu không có.
CLMSEX: Giới tính của người yêu cầu bồi thường. Giá trị 1 nếu là nam và giá trị 2 nếu là nữ.
MARITAL: Tình trạng hôn nhân của người yêu cầu bồi thường. Giá trị 1 nếu đã kết hôn, giá trị 2 nếu độc thân, giá trị 3 nếu góa vợ/chồng, và giá trị 4 nếu đã ly thân/ly dị.
CLMINSUR: Tình trạng bảo hiểm của người lái xe của người yêu cầu bồi. Giá trị 1 nếu có bảo hiểm, giá trị 2 nếu không có bảo hiểm, và giá trị 3 nếu không áp dụng.
SEATBELT: Cho biết người yêu cầu bồi thường có đang đeo dây an toàn/giữ trẻ em trong xe không. Giá trị 1 nếu có đeo, giá trị 2 nếu không đeo, và giá trị 3 nếu không áp dụng.
CLMAGE: Tuổi của người yêu cầu bồi thường, là một số nguyên.
LOSS: Tổng thiệt hại kinh tế của người yêu cầu bồi thường, tính theo đơn vị nghìn đô.
-Đầu tiên muốn lấy dữ liệu AutoBi thì chúng ta cần phải gọi lên gói package insuranceData
-Sau đó ta sử dụng lệnh data để lấy dữ liệu từ gói package trên
library(insuranceData)
data(AutoBi)
-Để thực hiện các lệnh dễ dàng hơn thì tôi gán dataset AutoBi vào một biến có tên là dat
-Nhận thấy dữ liệu này có nhiều kết quả NA nên tôi sẽ sử dụng lệnh na.omit để loại bỏ các dữ liệu NA
-Sau khi sử dụng lệnh na.omit thì biến đã dat loại bỏ các dữ liệu bị NA và còn 1091 obs
dat <- AutoBi
dat <- na.omit(dat)
-Tiếp theo, tôi dùng lệnh str để xem cấu trúc của bộ dữ liệu
-Kết quả cung cấp cho chúng ta thông tin về số lượng quan sát, số biến và tên của các biến, loại dữ liệu của từng biến, ví dụ các số liệu đầu tiên của từng biến
str(dat)
## 'data.frame': 1091 obs. of 8 variables:
## $ CASENUM : int 13 66 71 96 97 120 136 152 162 248 ...
## $ ATTORNEY: int 2 2 1 2 1 1 1 2 1 1 ...
## $ CLMSEX : int 2 1 1 1 2 1 2 2 2 1 ...
## $ MARITAL : int 2 2 1 4 1 2 2 2 1 1 ...
## $ CLMINSUR: int 1 2 2 2 2 2 2 2 2 2 ...
## $ SEATBELT: int 1 1 2 1 1 1 1 1 1 1 ...
## $ CLMAGE : int 28 5 32 30 35 19 34 61 37 42 ...
## $ LOSS : num 10.892 0.33 11.037 0.138 0.309 ...
## - attr(*, "na.action")= 'omit' Named int [1:249] 1 10 21 24 30 32 46 49 53 54 ...
## ..- attr(*, "names")= chr [1:249] "1" "10" "21" "24" ...
-Ta dùng lệnh summary để tạo ra một báo cáo tóm tắt các thông tin thống kê mô tả của các biến
-Kết quả bên dưới cho chúng ta biết các thông tin về trung bình, min, max, trung vị, các tứ phân vị của các biến
+Ví dụ về biến loss (tổng thiệt hại của người yêu cầu bồi thường ) người có tổng thiệt hại thấp nhất là 5 đô, người có tổng thiệt hại lớn nhất là khoảng 273 nghìn đô, trung bình thiệt hại là khoảng 5 nghìn đô, có 50% người có thiệt hại dưới mức 2.4 nghìn đô
summary(dat)
## CASENUM ATTORNEY CLMSEX MARITAL
## Min. : 13 Min. :1.000 Min. :1.000 Min. :1.000
## 1st Qu.: 8431 1st Qu.:1.000 1st Qu.:1.000 1st Qu.:1.000
## Median :17550 Median :1.000 Median :2.000 Median :2.000
## Mean :17250 Mean :1.474 Mean :1.565 Mean :1.591
## 3rd Qu.:26051 3rd Qu.:2.000 3rd Qu.:2.000 3rd Qu.:2.000
## Max. :34253 Max. :2.000 Max. :2.000 Max. :4.000
## CLMINSUR SEATBELT CLMAGE LOSS
## Min. :1.000 Min. :1.000 Min. : 0.00 Min. : 0.005
## 1st Qu.:2.000 1st Qu.:1.000 1st Qu.:19.00 1st Qu.: 0.753
## Median :2.000 Median :1.000 Median :31.00 Median : 2.435
## Mean :1.904 Mean :1.018 Mean :32.64 Mean : 5.326
## 3rd Qu.:2.000 3rd Qu.:1.000 3rd Qu.:43.00 3rd Qu.: 4.189
## Max. :2.000 Max. :2.000 Max. :95.00 Max. :273.604
-Ta nên đặt tên cho các biến trong bộ dữ liệu để thuận tiện trong việc xử lý dữ liệu bằng lệnh names
-Tôi đặt tên cho 8 biến trong dataframe phía trên theo thứ tự tương ứng với 8 tên là “case”,“att”,“sex”,“mar”,“ins”,“seat”,“age”,“los”
names(dat) <- c("case","att","sex","mar","ins","seat","age","los")
-Kế tiếp ta có thể sử dụng lệnh head để xem các quan sát đầu của dat và lệnh tail để xem một vài quan sát cuối
head(dat)
## case att sex mar ins seat age los
## 2 13 2 2 2 1 1 28 10.892
## 3 66 2 1 2 2 1 5 0.330
## 4 71 1 1 1 2 2 32 11.037
## 5 96 2 1 4 2 1 30 0.138
## 6 97 1 2 1 2 1 35 0.309
## 7 120 1 1 2 2 1 19 3.538
tail(dat)
## case att sex mar ins seat age los
## 1334 34189 2 1 2 2 1 49 0.100
## 1335 34204 2 2 2 2 1 26 0.161
## 1337 34220 1 2 1 2 1 46 3.705
## 1338 34223 2 2 1 2 1 39 0.099
## 1339 34245 1 2 2 1 1 18 3.277
## 1340 34253 2 2 2 2 1 30 0.688
-Để có thể lọc những người yêu cầu bồi thường mà có luật sư đại diện thì trong biến ATTORNEY( được đặt tên att) tôi sẽ chọn trong cột này những dữ liệu có giá trị là 1 và sau đó kết quả nhận được sẽ gán vào biến att1
-Kết quả chạy từ câu lệnh trên cho thấy rằng có 574 người có luật sư đại diện khoảng 52.6%
att1 <- dat[dat$att ==1,]
head(att1)
## case att sex mar ins seat age los
## 4 71 1 1 1 2 2 32 11.037
## 6 97 1 2 1 2 1 35 0.309
## 7 120 1 1 2 2 1 19 3.538
## 8 136 1 2 2 2 1 34 4.882
## 11 162 1 2 1 2 1 37 6.290
## 12 248 1 1 1 2 1 42 29.620
-Để tìm hiểu về những người tài xế đang trong tình trạng không có bảo hiểm thì ta có thể chọn những dữ liệu có giá trị là 2 trong biến CLMINSUR(ins)
-Kết quả đưa về sẽ được gán vào biến ir. Chúng ta nhận thấy có 986 người lái xe đang không có bảo hiểm khoảng 90.3% so với tổng số
ir <- dat[dat$ins == 2,]
head(ir)
## case att sex mar ins seat age los
## 3 66 2 1 2 2 1 5 0.330
## 4 71 1 1 1 2 2 32 11.037
## 5 96 2 1 4 2 1 30 0.138
## 6 97 1 2 1 2 1 35 0.309
## 7 120 1 1 2 2 1 19 3.538
## 8 136 1 2 2 2 1 34 4.882
-Tương tự, ở biến CASENUM(case) ta cũng có thể lọc số hồ sơ yêu cầu bồi thường lớn hơn 10000 và gán kết quả vào biến có tên case10
-Có 762 người có mã số hồ sơ trên 10000
case10 <- dat[dat$case>10000,]
head(case10)
## case att sex mar ins seat age los
## 401 10115 1 2 1 2 1 43 6.209
## 403 10129 1 1 1 2 1 83 28.209
## 404 10206 1 1 2 2 1 21 150.000
## 406 10256 1 1 2 2 1 23 4.776
## 407 10288 1 2 1 2 1 35 5.405
## 409 10308 1 2 2 2 1 25 2.998
-Ta cũng có thể lọc ra những người yêu cầu bồi thường là nam và độc thân bằng cách thêm vào dấu & giữa các điều kiện.Ta sẽ lấy ở biến sex những giá trị là 1 và biến mar giá trị là 2 và sau đó gán kết quả vào biến tên là sm
-Kết quả cho ta thấy rằng có 243 người yêu cầu bồi thường có giới tính là nam và tình trạng độc thân tương ứng với 21,4% trên tổng số
sm <- dat[dat$sex == 1 & dat$mar ==2 ,]
head(sm)
## case att sex mar ins seat age los
## 3 66 2 1 2 2 1 5 0.330
## 7 120 1 1 2 2 1 19 3.538
## 13 250 2 1 2 2 1 17 2.678
## 19 376 2 1 2 2 1 3 0.100
## 27 613 2 1 2 2 1 62 0.250
## 28 616 1 1 2 2 1 10 1.405
-Tương tự, ta có thể tìm những người có tổng thiệt hại từ 5-10 nghìn đô và gán vào l
-Có 117 người có tổng thiệt hại từ 5-10 nghìn đô khoảng 10.7% so với tổng số người khảo sát
l <- dat[dat$los>5 & dat$los<10,]
-Kế tiếp tôi sẽ tạo bảng tổng thiệt hại chia làm 5 khoảng bằng lệnh table
-Từ bảng kết quả cho ta thấy:
table(cut(dat$los,5 ))
##
## (-0.269,54.7] (54.7,109] (109,164] (164,219] (219,274]
## 1078 7 3 1 2
Tương tự ta có thể lập bảng về tổng thiệt hại tuy nhiên ta có thể thêm lập bảng dựa trên một biến khác
Dưới đây tôi lập bảng tổng thiệt hại dựa trên tình trạng thắt dây an toàn của người đang yêu cầu bồi thường. Trong đó giá trị 1 là có thắt dây an toàn và giá trị 2 là không có thắt dây an toàn
Kết quả từ bảng số liệu cho thấy rằng:
table(cut(dat$los,3 ),dat$seat)
##
## 1 2
## (-0.269,91.2] 1066 18
## (91.2,182] 2 2
## (182,274] 3 0
-Tương tự ta có thể tạo một bảng tuổi của người yêu cầu bảo hiểm dựa vào giới tính
-Từ kết quả:
table(cut(dat$age, breaks = c(-0.1,18,50,70,95) ),dat$sex)
##
## 1 2
## (-0.1,18] 111 136
## (18,50] 293 397
## (50,70] 54 71
## (70,95] 17 12