Tiểu Luận Kết Thúc Môn Học

library(dplyr)

## Warning: package 'dplyr' was built under R version 4.3.1

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(ggplot2)

## Warning: package 'ggplot2' was built under R version 4.3.1

library(scales)

## Warning: package 'scales' was built under R version 4.3.1

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 '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 ──
## ✔ forcats   1.0.0     ✔ stringr   1.5.0
## ✔ lubridate 1.9.2     ✔ tibble    3.2.1
## ✔ purrr     1.0.1     ✔ tidyr     1.3.0
## ✔ readr     2.1.4     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ readr::col_factor() masks scales::col_factor()
## ✖ purrr::discard()    masks scales::discard()
## ✖ dplyr::filter()     masks stats::filter()
## ✖ dplyr::lag()        masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(tidyselect)

## Warning: package 'tidyselect' was built under R version 4.3.1

library(epitools)
library(DescTools)

## Warning: package 'DescTools' was built under R version 4.3.1

library(caTools)

## Warning: package 'caTools' was built under R version 4.3.1

library(tidytext)

## Warning: package 'tidytext' was built under R version 4.3.1

Chương 1: Giới Thiệu

1.1 Lý do chọn Đề Tài

Đại dịch đã tác động lớn đến nền kinh tế toàn cầu và nhiều ngành nghề, khiến nhiều công việc bị gián đoạn hoặc giảm bớt,rất nhiều doanh nghiệp và tổ chức đã chuyển sang hình thức làm việc từ xa để giảm nguy cơ lây nhiễm và duy trì hoạt động.Một số ngành nghề có nhu cầu tăng cao như chăm sóc sức khỏe, dược phẩm, dịch vụ giao hàng, công nghệ thông tin và truyền thông trực tuyến,nhiều doanh nghiệp có thể giảm đầu tư tuyển dụng hoặc dừng tuyển mới trong bối cảnh khó khăn kinh tế.Nhiều doanh nghiệp phải chuyển đổi và thích ứng để duy trì hoạt động thông qua giao dịch trực tuyến, cài đặt hệ thống làm việc từ xa, và sử dụng công nghệ.

Chính vì thế, tôi thực hiện nghiên cứu về các yếu tố tác động đến công việc trước và sau đại dịch theo từng độ tuổi dựa trên bảng khảo sát thông tin.

1.2 Mục Tiêu Nghiên Cứu

Dựa trên những dữ liệu đã thu thập được mục tiêu chính của đề tài này là phân tích các yếu tố ảnh hưởng đến tâm lý của dịch Covid

1.3 Đối tượng nghiên cứu

Đối tượng nghiên cứu: các yếu tố ảnh hưởng đến tâm lý của dịch Covid Về hướng kĩ thuật, nghiên cứu này có đối tượng là dữ liệu thời gian. Các đối tượng trong quan hệ là dữ liệu thời gian theo độ tuổi từ 19 đến 60 tuổi trở lên

1.4 Phương pháp nghiên cứu

Sử dụng mô hình hồi quy tuyến tính để phân tích các yếu tố anh hưởng đến tâm lý công việc trước và sau đại dịch

1.5 Kết cấu đề bài

Chương 1 Giới thiệu

Chương 2 Tổng quan lý thuyết

Chương 3 Thiết kế nghiên cứu

Chương 4 Kết quả nghiên cứu

Chương 5 Kết luận

Chương 2 Tổng quan lý thuyết

2.1 Đánh giá mức độ thư giãn trong công việc trước và trong dịch (relaxed)

Mức độ thư giãn trong công việc có thể có sự khác biệt đáng kể giữa trước và trong đại dịch COVID-19. Dưới đây là một số điểm đánh giá chung về mức độ thư giãn trong công việc trong hai giai đoạn này:

Trước đại dịch:

Môi trường làm việc đa dạng: Trước khi đại dịch bùng phát, nhiều người làm việc tại văn phòng, nhà máy, cửa hàng hoặc các nơi công cộng khác. Môi trường làm việc trực tiếp này có thể mang lại cảm giác thoải mái và gắn kết với đồng nghiệp.

Giao tiếp trực tiếp: Làm việc trực tiếp cho phép bạn dễ dàng giao tiếp và tương tác với đồng nghiệp, giúp giảm căng thẳng và cải thiện tinh thần làm việc.

Cơ hội vui chơi và thư giãn: Trước đại dịch, người lao động thường có nhiều cơ hội thư giãn sau giờ làm việc, chẳng hạn như đi dạo chơi, đi xem phim, hẹn hò với bạn bè hay tham gia các hoạt động giải trí khác.

Trong đại dịch:

Làm việc từ xa: Đại dịch COVID-19 đã tác động mạnh mẽ đến môi trường làm việc, khiến rất nhiều người phải làm việc từ xa. Mặc dù có những lợi ích như tiết kiệm thời gian di chuyển, nhưng làm việc từ xa có thể làm mất đi sự gắn kết và tương tác trực tiếp với đồng nghiệp.

Căng thẳng và lo âu: Đại dịch gây ra một môi trường không chắc chắn và lo lắng, khiến nhiều người phải đối mặt với cảm giác bất an về công việc và tương lai.

Thiếu cơ hội thư giãn: Với hạn chế di chuyển và giãn cách xã hội, nhiều cơ hội thư giãn sau giờ làm việc đã bị hạn chế. Điều này có thể làm tăng mức độ căng thẳng và giảm đi sự thư giãn sau một ngày làm việc căng thẳng.

Mức độ thư giãn trong công việc có thể thay đổi tùy thuộc vào từng trường hợp cụ thể. Một số người có thể thấy thư giãn hơn khi làm việc từ xa, trong khi người khác có thể cảm thấy cô đơn và cần tìm cách tạo ra môi trường làm việc thư giãn tại nhà. Trong mọi trường hợp, quản lý tâm lý và tạo ra cân bằng trong công việc và cuộc sống cá nhân rất quan trọng để duy trì mức độ thư giãn và sự hài lòng trong công việc.

2.2 Nghể nghiệp trước và trong dịch (occupation)

Nghề nghiệp trước và trong đại dịch có thể có sự khác biệt rõ rệt, đặc biệt là do ảnh hưởng của đại dịch COVID-19 lên nền kinh tế và các ngành nghề. Dưới đây là một số ví dụ về sự thay đổi và tác động của đại dịch đối với một số ngành nghề cụ thể:

Ngành y tế và chăm sóc sức khỏe:

Trước đại dịch: Ngành y tế và chăm sóc sức khỏe đã là lĩnh vực ổn định và có nhu cầu cao về nhân lực. Trong đại dịch: Các chuyên gia y tế và nhân viên chăm sóc sức khỏe trở thành nhóm người có vai trò quan trọng trong đối phó với đại dịch. Nhu cầu về nhân lực trong ngành này tăng cao, đặc biệt là ở các bệnh viện và các cơ sở chăm sóc sức khỏe cơ sở.

Một số ngành nghề phổ biến như:

Công nghệ thông tin và truyền thông trực tuyến: Trước đại dịch: Công nghệ thông tin đã phát triển nhanh chóng và trở thành một lĩnh vực có nhiều cơ hội việc làm. Trong đại dịch: Đại dịch đã thúc đẩy việc sử dụng công nghệ thông tin và truyền thông trực tuyến hơn bao giờ hết. Các công ty công nghệ và truyền thông trực tuyến như Zoom, Microsoft Teams, và các nền tảng giáo dục trực tuyến đã trở nên phổ biến hơn và có nhu cầu cao về kỹ thuật viên, lập trình viên, và chuyên gia liên quan.

Ngành du lịch và dịch vụ hàng không: Trước đại dịch: Ngành du lịch và dịch vụ hàng không phát triển mạnh mẽ, cung cấp nhiều cơ hội việc làm liên quan đến dịch vụ, khách sạn, hàng không, hướng dẫn du lịch, v.v. Trong đại dịch: Đại dịch đã ảnh hưởng nặng nề đến ngành du lịch và dịch vụ hàng không. Hạn chế di chuyển và giãn cách xã hội đã làm giảm mạnh nhu cầu du lịch và dịch vụ liên quan, dẫn đến việc giảm bớt các cơ hội việc làm trong lĩnh vực này.

Ngành sản xuất và nhà máy: Trước đại dịch: Ngành sản xuất và nhà máy thường hoạt động với nhiều công nhân và quy mô sản xuất lớn. Trong đại dịch: Nhiều nhà máy và cơ sở sản xuất đã phải điều chỉnh quy trình và triển khai biện pháp giãn cách xã hội để đảm bảo an toàn cho nhân viên. Điều này có thể làm giảm quy mô sản xuất và ảnh hưởng đến nhu cầu về lao động trong ngành này.

Chương 3 Thiết kế nghiên cứu

3.1 Giới thiệu mô hình hồi quy tuyến tính

Mô hình hồi quy tuyến tính là một trong những phương pháp thống kê cơ bản được sử dụng để dự đoán mối quan hệ tuyến tính giữa một biến phụ thuộc (outcome variable) và một hoặc nhiều biến độc lập (predictor variables). Trong R, việc xây dựng mô hình hồi quy tuyến tính được thực hiện bằng cách sử dụng hàm lm() (Linear Model).

gồm có 5 bước như:

1. chuẩn bị dữ liệu

2. Xác định biến phụ thuộc và biến độc lập

3. Xây dựng mô hình hồi quy tuyến tính

4. Kiểm tra và đánh giá mô hình

5. Đọc kết quả

6. Dự đoán với mô hình

Chương 4 Kết Quả nghiên cứu

4.1 Tổng Quan về dữ liệu

Bộ dữ liệu sử dụng trong phân tích được lấy từ trang kaggle.com,có 1176 quan sát gồm 8 biến định tính và 9 biến định lượng

age: nhóm tuổi

gender: Giới tính

occupation: Nghề nghiệp

line_of_work: Dòng công việc do người đó thực hiện

time_bp: Thời gian dành cho công việc trước đại dịch

time_dp: Thời gian dành cho công việc trong thời kỳ đại dịch

travel_time: Thời gian di chuyển

easeof_online: Thích công việc trực tuyến

home_env: Thích môi trường gia đình

prod_inc: Đánh giá tăng năng suất

sleep_bal: Đánh giá chu kỳ giấc ngủ

new_skill: Có bất kỳ kỹ năng mới nào đã được học hay không

fam_connect: Đánh giá mức độ kết nối của người đó với gia đình

relaxed: Đánh giá mức độ thư giãn của người đó

self_time: Đánh giá bao nhiêu thời gian bản thân đã được mua

like_hw: Thích làm việc tại nhà

dislike_hw: Không thích làm việc tại nhà

prefer: làm việc tại nhà hay đi học

certaindays_hw: Thích liệu một số ngày làm việc tại nhà có cần thiết hay không

library(readxl)
psyco <- read_excel("D:/psyco.xlsx")
View(psyco)
str(psyco)

## tibble [1,175 × 19] (S3: tbl_df/tbl/data.frame)
##  $ age           : chr [1:1175] "19-25" "19-25" "19-25" "19-25" ...
##  $ gender        : chr [1:1175] "Male" "Male" "Male" "Male" ...
##  $ occupation    : chr [1:1175] "Student in College" "Student in School" "Student in College" "Student in College" ...
##  $ line_of_work  : chr [1:1175] NA NA NA NA ...
##  $ time_bp       : num [1:1175] 7 7 7 7 7 5 5 7 5 7 ...
##  $ time_dp       : num [1:1175] 5 11 7 7 7 7 4 9 9 7 ...
##  $ travel_time   : num [1:1175] 0.5 0.5 1.5 1.5 1.5 0.5 0.5 0.5 0.5 1.5 ...
##  $ easeof_online : num [1:1175] 1 1 2 2 2 1 2 2 2 1 ...
##  $ home_env      : num [1:1175] 2 1 2 1 2 2 1 1 2 1 ...
##  $ prod_inc      : num [1:1175] 0 -0.5 1 0 0 -1 0.5 0 1 0 ...
##  $ sleep_bal     : num [1:1175] 0 0.5 0 1 0 -1 0.5 -0.5 1 0 ...
##  $ new_skill     : num [1:1175] 0.5 -1 0.5 0.5 0 0 1 -0.5 1 0 ...
##  $ fam_connect   : num [1:1175] 1 1 0.5 0 0 -0.5 0.5 -1 1 -1 ...
##  $ relaxed       : num [1:1175] -0.5 1 0.5 -1 0.5 0 1 -0.5 1 0 ...
##  $ self_time     : num [1:1175] -0.5 1 0.5 -0.5 0 0 1 0 1 0 ...
##  $ like_hw       : num [1:1175] 100 1111 1100 100 1010 ...
##  $ dislike_hw    : num [1:1175] 1 1110 111 1111 1000 ...
##  $ prefer        : chr [1:1175] "Complete Physical Attendance" "Complete Physical Attendance" "Complete Physical Attendance" "Complete Physical Attendance" ...
##  $ certaindays_hw: chr [1:1175] "No" "No" "Yes" "No" ...

4.2 Chọn biến định tính và biến định lượng làm biến phụ thuộc

4.2.1 Chọn biến định tính làm biến phụ thuộc

Chọn biến định tính prefer là biến phụ thuộc

Giải thích: nhằm đánh giá xe các yếu tố như Thích liệu một số ngày làm việc tại nhà có cần thiết hay không, Thích công việc trực tuyến Thích môi trường gia đình

4.2.2 Chọn biến định lượng làm biến phụ thuộc

Chọn biến định lượng relaxed phụ thuộc

Giải thích: Mức độ thư giãn phụ thuộc vào dòng công việc của nười đó hiện tại, công viện trực tiếp hay trực tuyến nếu công việc khác nhau cũng làm ảnh hưởng đến tâm lý

4.3 Thống kê mô tả

4.3.1 Thống kê mô tả các biến định tính

4.3.1.1 Biến prefer(số người thích làm việc tại nhà hay đi học)

Bảng tần số

table(psyco$prefer)

## 
## Complete Physical Attendance         Work/study from home 
##                          836                          339

có 836 người đi học đầu đủ tham gia cuộc bình chọn và 339 người thích học làm việc tại nhà tham gia bình chọn

table(psyco$prefer)/sum(table(psyco$prefer))

## 
## Complete Physical Attendance         Work/study from home 
##                    0.7114894                    0.2885106

tỉ lệ đi học đầy đủ chiếm 71.14% và thích học và làm việc tại nhà chiếm 28.8%

Đồ thị

psyco |> ggplot(aes(x = prefer, y = after_stat(count))) +
geom_bar(fill = 'black') +geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat ='count', color = 'red', vjust = - .5) +labs(x = 'người làm việc tại nhà', y = 'số người')

Dựa vào đồ thị ta thấy số người thích đi học lên đến 836 người so với 1157 người chiếm 71% và số người thích học tập và làm việc tại nah2 chiếm 29%

4.3.1.2 Biến occupation (Nghề nghiệp)

Bảng tần số

table(psyco$occupation)

## 
##                                Currently Out of Work 
##                                                   44 
##                                         Entrepreneur 
##                                                  119 
##                                            Homemaker 
##                                                   82 
## Medical Professional aiding efforts against COVID-19 
##                                                   73 
##                               Retired/Senior Citizen 
##                                                    2 
##                                   Student in College 
##                                                  358 
##                                    Student in School 
##                                                   18 
##                                 Working Professional 
##                                                  479

Từ bảng ta thấy có 44 người không có việc làm tham gia vào vuộc bình chọn 82 người nội trợ 2 Người đã nghỉ hưu/Người cao tuổi tham gia bình chọn có 18 người là sinh viên, có 119 doanh nhân có 73 người nỗ lực hỗ trợ của Chuyên gia Y tế chống lại COVID-19 tham gia bình chọn có 358 sinh viên đại học tham gia bình chọn, có 479 người làm việc chuyên nghiệp tham gia bình chọn

table(psyco$occupation)/sum(table(psyco$occupation))

## 
##                                Currently Out of Work 
##                                          0.037446809 
##                                         Entrepreneur 
##                                          0.101276596 
##                                            Homemaker 
##                                          0.069787234 
## Medical Professional aiding efforts against COVID-19 
##                                          0.062127660 
##                               Retired/Senior Citizen 
##                                          0.001702128 
##                                   Student in College 
##                                          0.304680851 
##                                    Student in School 
##                                          0.015319149 
##                                 Working Professional 
##                                          0.407659574

Tỉ lệ người không có việc làm chiêm 0.37% người nội trợ chiếm 0.698% Người đã nghỉ hưu/Người cao tuổi chiếm 0.1% sinh viên chiếm 0.15% doanh nhân chiếm 10.1% người nỗ lực hỗ trợ của Chuyên gia Y tế chống lại COVID-19 chiếm 6.21% sinh viên đại học chiếm 30.4% ngyuoi72 làm việc chuyên nghiệp chiếm 40.7%

Đồ thị

library(ggplot2)
psyco |> ggplot(aes(x = occupation, y = after_stat(count))) +
geom_bar(fill = 'black') +geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat ='count', color = 'red', vjust = - .5) +labs(x = 'Công việc', y = 'số tuổi')

Từ đồ thị ta thấy công việc Working Professional được nhiều người ưa chuộng nhất có 479 trên tổng 1175 người chiếm 40.77% và Retired/Senior Citizen chiếm 2 người trong 1175 người chiếm 0.17%

4.3.1.3 Biến gender (giới tính)

Bảng tần số

table(psyco$gender)

## 
## Female   Male 
##    521    654

Có 512 người nữ tham gia bình chọn và 654 nam tham gia

table(psyco$gender)/sum(table(psyco$gender))

## 
##    Female      Male 
## 0.4434043 0.5565957

Tỉ lệ nữ chiếm 44.3% và nam chiếm 55.6%

Đồ thị

psyco |> ggplot(aes(x = gender, y = after_stat(count))) +
geom_bar(fill = 'black') +geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat ='count', color = 'red', vjust = - .5) +labs(x = 'giới tính', y = 'Công việc')

Từ đồ thị ta thấy tỷ lệ nam giới có công việc trước và trong dịch là 654 người trên tổng 1157 nguời chiếm 56% tỷ lệ nữ giới trước và trong dịch có công việc là 512 người chiếm 44%

4.3.1.4 Biến certaindays_hw (số người thích làm công việc tại nhà)

Bảng tần số

table(psyco$certaindays_hw)

## 
##  No Yes 
## 576 599

số người thích công việc tại nhà là 568 người không thích là 309 người khác là 298 người

table(psyco$certaindays_hw)/sum(table(psyco$certaindays_hw))

## 
##        No       Yes 
## 0.4902128 0.5097872

tỉ lệ đồng ý chiếm 48.34% không đồng ý chiếm 26.29% khác chiếm 25.36%

Đồ thị

library(ggplot2)
psyco |> ggplot(aes(x = certaindays_hw, y = after_stat(count))) +
geom_bar(fill = 'black') +geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat ='count', color = 'red', vjust = - .5) +labs(x = 'làm việc tại nhà có cần thiết không', y = 'công việc')

Từ đồ thị ta thấy mục độ cần thiết làm công việc tại nhà là 48.34%, Mức độ không cần thiết làm tại nhà là 26.30%, Mức độ làm tại nhà hay làm tại cửa hàng là 25.36% trên tổng 1157 biến

4.3.1.5 Biến easeof_online: Thích công việc trực tuyến

Bảng tần số

table(psyco$easeof_online)

## 
##   1   2 
## 592 583

có 592 người thích công việc trực tuyến và 583 người không thích công việc trực tuyến

table(psyco$easeof_online)/sum(table(psyco$easeof_online))

## 
##         1         2 
## 0.5038298 0.4961702

người thích công việc trực tuyến chiếm 50.3% và không thích công việc trực tuyến chiếm 49.6%

Đồ thị

library(ggplot2)
psyco |> ggplot(aes(x = easeof_online, y = after_stat(count))) +
geom_bar(fill = 'black') +geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat ='count', color = 'red', vjust = - .5) +labs(x = 'thích công việc trực tuyến', y = 'công việc')

Từ đồ thị ta thấy số người thích công việc trực tuyến chiếm 50.38% và không thích chiếm 49.62%

4.3.1.6 Biến home_env: Thích môi trường gia đình

Bảng tần số

table(psyco$home_env)

## 
##   1   2 
## 555 620

số người thích môi trường gia đình 555 người trên tổng 1157 người và 620 người không thích

table(psyco$home_env)/sum(table(psyco$home_env))

## 
##         1         2 
## 0.4723404 0.5276596

tỉ lệ người thích môi trường gia đình chiếm 47.23% và không thích chiếm 52.7%

Đồ thị

library(ggplot2)
psyco |> ggplot(aes(x = home_env, y = after_stat(count))) +
geom_bar(fill = 'black') +geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat ='count', color = 'red', vjust = - .5) +labs(x = 'thích môi trường gia đình', y = 'công việc')

Từ đồ thị ta thấy mục độ thích môi trường gia đình chiếm 52.8% và không thích môi truong gia đình chiếm 47.2%

4.3.2 Thống kê mô tả các biến định lượng

4.3.2.1 Thống kê mô tả biến relaxed

Bảng tần số

table(psyco$relaxed)

## 
##   -1 -0.5    0  0.5    1 
##  144  268  306  274  183

table(psyco$relaxed)/sum(table(psyco$relaxed))

## 
##        -1      -0.5         0       0.5         1 
## 0.1225532 0.2280851 0.2604255 0.2331915 0.1557447

Đồ thị

psyco |> ggplot(aes(x = relaxed, y = after_stat(count))) +
geom_bar(fill = 'black') +geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat ='count', color = 'red', vjust = - .5) +labs(x = 'thời gian nghỉ ngơi', y = 'Công việc')

4.3.2.2 Thống kê mô tả biến age

Bảng tần số

table(psyco$age)

## 
## 19-25 26-32 33-40 40-50 45278 50-60   60+ 
##   346   261   102   181    73   170    42

từ bàng ta thấy có 346 người từ đổ tuổi 19-25 tham gia cuộc bình chọn 261 người từ độ tuổi 26-32 tham gia cuộc bình chọn 102 người từ độ tuổi 33-40 tham gia cuộc bình chọn có 181 người từ độ tuổi 40-50 tham gia bình chọn có 170 tham gia bình chọn rừ độ tuổi 50-60 có 42 người trên 60+ tham gia bình chọn

table(psyco$age)/sum(table(psyco$age))

## 
##      19-25      26-32      33-40      40-50      45278      50-60        60+ 
## 0.29446809 0.22212766 0.08680851 0.15404255 0.06212766 0.14468085 0.03574468

Tì lệ tuối tham gia bình chọn từ 19-25 chiếm 29.44% 26-32 chiếm 22.2% 33-40 chiếm 0.86% 40-50 chiếm 15.4% 50-60 chiếm 14.4% trên 60+ chiếm 3.57%

Đồ thị

psyco |> ggplot(aes(x = age, y = after_stat(count))) +
geom_bar(fill = 'black') +geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat ='count', color = 'red', vjust = - .5) +labs(x = 'Độ tuổi', y = 'Công việc')

Từ đồ thị ta thấy những người có độ tuổi từ 19-25 có công việc cao nhất gồm 346 trên tổng 1175 người chiếm 29.45% và số người có công việc thấp nhất ở độ tuổi 60+ với 42 người chiếm 3.57%

4.3.2.3 Thống kê mô tả biến time_bp (Thời gian dành cho công việc trước đại dịch)

table(psyco$time_bp)

## 
##   4   5   7   9  11  12 
##  33 283 412 343  53  51

thời gian dành cho công việc 4 tiếng 1 ngày có 33 người 5 tiếng có 283 người 7 tiếng có 412 người 9 tiếng có 343 người 11 tiếng có 53 người 12 tiếng có 51 người

table(psyco$time_bp)/sum(table(psyco$time_bp))

## 
##          4          5          7          9         11         12 
## 0.02808511 0.24085106 0.35063830 0.29191489 0.04510638 0.04340426

4 tiếng chiếm 0.28% 5 tiếng chiếm 24.08% 7 tiếng chiếm 35.06% 9 tiếng chiếm 29.19% 11 tiếng chiếm 4.51% 12 tiếng chiếm 4.34%

Đồ thị

psyco |> ggplot(aes(x = time_bp, y = after_stat(count))) +
geom_bar(fill = 'black') +geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat ='count', color = 'red', vjust = - .5) +labs(x = 'thời gian công việc trước đại dịch', y = 'số người')

dựa vào biểu đồ ta thấy thởi gian dành cho cong việc ở mức 7 chiếm 412 người trên 1157 người chiếm 35.06% và mức 4 chiếm ít nhất với 2.81%

4.3.2.4 Thống kê mô tả biến time_dp(Thời gian dành cho công việc sau đại dịch)

table(psyco$time_dp)

## 
##   4   5   7   9  11  12 
## 149 180 238 326 113 169

thời gian dành cho công việc 4 tiếng 1 ngày có 149 người 5 tiếng có 180 người 7 tiếng có 283 người 9 tiếng có 326 người 11 tiếng có 113 người 12 tiếng có 169 người

table(psyco$time_bp)/sum(table(psyco$time_bp))

## 
##          4          5          7          9         11         12 
## 0.02808511 0.24085106 0.35063830 0.29191489 0.04510638 0.04340426

4 tiếng chiếm 0.28% 5 tiếng chiếm 24.08% 7 tiếng chiếm 35.06% 9 tiếng chiếm 29.19% 11 tiếng chiếm 4.51% 12 tiếng chiếm 4.34%

Đồ thị

psyco |> ggplot(aes(x = time_bp, y = after_stat(count))) +
geom_bar(fill = 'black') +geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat ='count', color = 'red', vjust = - .5) +labs(x = 'thời gian công việc sau đại dịch', y = 'số người')

Dựa vào đồ thị ta thấy thời gian trung bình người đi làm trước đại dịch lên đến 326 trên tông 1175 người chiếm 35.06% và thấp nhất ở mức 149 người chiếm 2.81%

4.3.2.5 Biến prod_inc ( Đánh giá tăng năng suất)

table(psyco$prod_inc)

## 
##   -1 -0.5    0  0.5    1 
##  150  279  295  302  149

tăng năng suất ở múc -1 là 150 người -0.5 là 279 người 0 là 295 0.5 là 302 người mức 1 là 149 người

table(psyco$prod_inc)/sum(table(psyco$prod_inc))

## 
##        -1      -0.5         0       0.5         1 
## 0.1276596 0.2374468 0.2510638 0.2570213 0.1268085

chiếm 12.7% ở mức -1 23.7% mức -0.5 25.10% ở mức 0 25.7% ở mức 0.5 12.6% ờ mức 1

psyco |> ggplot(aes(x = prod_inc, y = after_stat(count))) +
geom_bar(fill = 'black') +geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat ='count', color = 'red', vjust = - .5) +labs(x = 'đánh giá tăng năng suất', y = 'số người')

Dữa vào đồ thị thấy có 302 người được đánh giá tăng năng suất trên tổng 1157 người chiếm 25.7052% và 149 người đánh giá ít nhất chiếm 12.681%

4.3.2.6 Biến sleep_bal (Đánh giá chu kỳ giấc ngủ)

table(psyco$sleep_bal)

## 
##   -1 -0.5    0  0.5    1 
##  214  313  270  271  107

Đánh giá giấc ngủ ở mức -1 là 214 người -0.5 là 313 người 0 là 270 người 0.5 là 271 người 1 là 107 người

table(psyco$sleep_bal)/sum(table(psyco$sleep_bal))

## 
##         -1       -0.5          0        0.5          1 
## 0.18212766 0.26638298 0.22978723 0.23063830 0.09106383

mức -1 chiếm 18.21% mức -0.5 chiếm 26.6% mức 0 chiếm 22.9% mức 0.5 chiếm 23.06% mức 1 chiếm 9.16%

Đồ thị

psyco |> ggplot(aes(x = sleep_bal, y = after_stat(count))) +
geom_bar(fill = 'black') +geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat ='count', color = 'red', vjust = - .5) +labs(x = 'giấc ngủ', y = 'số người')

Dựa vào biểu đồ ta thấy có tông 313 người dược đánh giá giấc ngủ chiếm 26.638% và có ít nhất 107 người chiếm 9.106%

4.3.2.7 Thống kê mô tả biến fam_connect

table(psyco$fam_connect)

## 
##   -1 -0.5    0  0.5    1 
##  181   92  162  414  326

ở mức -1 là 181 người -0.5 là 91 người 0 là 162 người 0.5 là 414 người 1 là 326 người

table(psyco$fam_connect)/sum(table(psyco$fam_connect))

## 
##         -1       -0.5          0        0.5          1 
## 0.15404255 0.07829787 0.13787234 0.35234043 0.27744681

mức -1 chiếm 15.40% mức -0.5 chiếm 7.82% mức 0 chiếm 13.7% mức 0.5 chiếm 35.23% mức 1 chiếm 27.7%

Đồ thị

psyco |> ggplot(aes(x = sleep_bal, y = after_stat(count))) +
geom_bar(fill = 'black') +geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat ='count', color = 'red', vjust = - .5) +labs(x = 'mức độ kết nối của người đó với gia đình', y = 'số người')

Từ đồ thị ta thấy mức độ kết nối của người đó với gia đình cao nhất ở độ tuổi 60+ có 326 người chiếm 9.106%

4.4 Thống kê suy diễn cho dữ liệu định tính

4.4.1 Kiểm định tính độc lập cho 2 biến định tính

4.4.1.1 Biến prefer và biến gender

prefer = psyco$prefer
gender = psyco$gender

dt1 <- table(prefer, psyco$gender)
dt1

##                               
## prefer                         Female Male
##   Complete Physical Attendance    311  525
##   Work/study from home            210  129

chisq.test(dt1)

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  dt1
## X-squared = 58.848, df = 1, p-value = 1.704e-14

Kết quả kiểm định cho thấy, P-value < 0.05 vì vậy bác bỏ giả thuyết H0, tức là nghề nghiệp của người đó và giới tính có quan hệ với nhau

4.4.1.2 Biến prefer và biến home_env

dt2 <- table(prefer, psyco$home_env)
dt2

##                               
## prefer                           1   2
##   Complete Physical Attendance 395 441
##   Work/study from home         160 179

chisq.test(dt2)

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  dt2
## X-squared = 0, df = 1, p-value = 1

Kết quả kiểm định cho thấy, P-value < 0.05 vì vậy bác bỏ giả thuyết H0, tức là nghề nghiệp và số người làm việc tại nhà có quan hệ với nhau

4.4.1.3 Biến prefer và biến certaindays_hw

dt3 <- table(prefer, psyco$certaindays_hw)
dt3

##                               
## prefer                          No Yes
##   Complete Physical Attendance 410 426
##   Work/study from home         166 173

chisq.test(dt3)

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  dt3
## X-squared = 0, df = 1, p-value = 1

Kết quả kiểm định cho thấy, P-value < 0.05 vì vậy bác bỏ giả thuyết H0, tức là đi học hay đi làm và ột số ngày làm việc tại nhà có cần thiết hay không có quan hệ với nhau

4.4.1.4 Biến prefer và biến easeof_online

dte <- table(prefer, psyco$easeof_online)
dte

##                               
## prefer                           1   2
##   Complete Physical Attendance 441 395
##   Work/study from home         151 188

chisq.test(dte)

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  dte
## X-squared = 6.1767, df = 1, p-value = 0.01294

Kết quả kiểm định cho thấy, P-value < 0.05 vì vậy bác bỏ giả thuyết H0, tức là đi học hay đi làm và thích công việc trực tuyến có quan hệ với nhau

4.4.1.5 Biến prefer và biến home_env

dth <- table(prefer, psyco$home_env)
dth

##                               
## prefer                           1   2
##   Complete Physical Attendance 395 441
##   Work/study from home         160 179

chisq.test(dth)

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  dth
## X-squared = 0, df = 1, p-value = 1

Kết quả kiểm định cho thấy, P-value < 0.05 vì vậy bác bỏ giả thuyết H0, tức là đi học hay đi làm và thích môi trường gia đình có quan hệ với nhau

4.4.1.6 Biến relaxed và biến age

relaxed = psyco$relaxed
dt4 <- table(relaxed, psyco$age)
dt4

##        
## relaxed 19-25 26-32 33-40 40-50 45278 50-60 60+
##    -1      65     5     2    27     7    36   2
##    -0.5    67    23    47     4    23   104   0
##    0       89   130     5    45    28     9   0
##    0.5     78    14    46   103    12    20   1
##    1       47    89     2     2     3     1  39

chisq.test(dt4)

## 
##  Pearson's Chi-squared test
## 
## data:  dt4
## X-squared = 829.59, df = 24, p-value < 2.2e-16

Kết quả kiểm định cho thấy, P-value < 0.05 vì vậy bác bỏ giả thuyết H0, tức là mức độ thư giãn của người đó và độ tuổi có quan hệ với nhau

4.4.1.7 Biến relaxed và biến prefer

dt5 <- table(relaxed, psyco$age)
dt5

##        
## relaxed 19-25 26-32 33-40 40-50 45278 50-60 60+
##    -1      65     5     2    27     7    36   2
##    -0.5    67    23    47     4    23   104   0
##    0       89   130     5    45    28     9   0
##    0.5     78    14    46   103    12    20   1
##    1       47    89     2     2     3     1  39

chisq.test(dt5)

## 
##  Pearson's Chi-squared test
## 
## data:  dt5
## X-squared = 829.59, df = 24, p-value < 2.2e-16

Kết quả kiểm định cho thấy, P-value < 0.05 vì vậy bác bỏ giả thuyết H0, tức là mức độ thư giãn của người đó và số người làm việc tại nhà hay đi học có quan hệ với nhau

4.4.1.8 Biến relaxed và biến certaindays_hw

dt6 <- table(relaxed, psyco$certaindays_hw)
dt6

##        
## relaxed  No Yes
##    -1    70  74
##    -0.5 132 136
##    0    153 153
##    0.5  123 151
##    1     98  85

chisq.test(dt6)

## 
##  Pearson's Chi-squared test
## 
## data:  dt6
## X-squared = 3.5068, df = 4, p-value = 0.4769

Kết quả kiểm định cho thấy, P-value < 0.05 vì vậy bác bỏ giả thuyết H0, tức là mức độ thư giãn của người đó và một số ngày làm việc tại nhà có cần thiết hay không có quan hệ với nhau

4.4.1.9 Biến relaxed và biến travel_time

dt7 <- table(relaxed, psyco$travel_time)
dt7

##        
## relaxed 0.5 1.5 2.5   3
##    -1    64  42  24  14
##    -0.5 206  57   2   3
##    0    206  82  18   0
##    0.5  140  67  63   4
##    1     83  95   4   1

chisq.test(dt7)

## Warning in chisq.test(dt7): Chi-squared approximation may be incorrect

## 
##  Pearson's Chi-squared test
## 
## data:  dt7
## X-squared = 225.33, df = 12, p-value < 2.2e-16

ết quả kiểm định cho thấy, P-value < 0.05 vì vậy bác bỏ giả thuyết H0, tức là mức độ thư giãn của người đó và thời gian di chuyển có quan hệ với nhau

4.1.1.10 Biến relaxed và biến self_time

dt8 <- table(relaxed, psyco$self_time)
dt8

##        
## relaxed  -1 -0.5   0 0.5   1
##    -1    53   72  12   5   2
##    -0.5   6  146  92  23   1
##    0      9   26 177  92   2
##    0.5    0    7  81 166  20
##    1      1    1  55   3 123

chisq.test(dt8)

## 
##  Pearson's Chi-squared test
## 
## data:  dt8
## X-squared = 1406.9, df = 16, p-value < 2.2e-16

Kết quả kiểm định cho thấy, P-value < 0.05 vì vậy bác bỏ giả thuyết H0, tức là mức độ thư giãn của người đó và mức độ kết nối của đánh giá bao nhiêu thời gian bản thân đã được mua có quan hệ với nhau

4.4.1.11 Biến relaxed và biến gender

dt9 <- table(relaxed, psyco$gender)
dt9

##        
## relaxed Female Male
##    -1       60   84
##    -0.5    161  107
##    0        70  236
##    0.5     122  152
##    1       108   75

chisq.test(dt9)

## 
##  Pearson's Chi-squared test
## 
## data:  dt9
## X-squared = 100.4, df = 4, p-value < 2.2e-16

Kết quả kiểm định cho thấy, P-value < 0.05 vì vậy bác bỏ giả thuyết H0, tức là mức độ thư giãn của người đó và giới tính có quan hệ với nhau

4.4.2 Rủi ro tương đối (Risk ratio) và rỷ lệ chênh (oddsratio)

4.4.2.1 Biến Biến prefer và biến gender

library(epitools)
d1 <- table(psyco$prefer, psyco$gender)
riskratio(d1)

## $data
##                               
##                                Female Male Total
##   Complete Physical Attendance    311  525   836
##   Work/study from home            210  129   339
##   Total                           521  654  1175
## 
## $measure
##                               risk ratio with 95% C.I.
##                                 estimate     lower     upper
##   Complete Physical Attendance 1.0000000        NA        NA
##   Work/study from home         0.6059503 0.5239007 0.7008499
## 
## $p.value
##                               two-sided
##                                  midp.exact fisher.exact   chi.square
##   Complete Physical Attendance           NA           NA           NA
##   Work/study from home         1.165734e-14  1.30989e-14 1.025679e-14
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

epitab(d1, method = "oddsratio")

## $tab
##                               
##                                Female       p0 Male        p1 oddsratio
##   Complete Physical Attendance    311 0.596929  525 0.8027523 1.0000000
##   Work/study from home            210 0.403071  129 0.1972477 0.3638912
##                               
##                                    lower     upper     p.value
##   Complete Physical Attendance        NA        NA          NA
##   Work/study from home         0.2805031 0.4720688 1.30989e-14
## 
## $measure
## [1] "wald"
## 
## $conf.level
## [1] 0.95
## 
## $pvalue
## [1] "fisher.exact"

4.4.2.2 Biến prefer và biến easeof_online

library(epitools)
d2 <- table(psyco$prefer, psyco$easeof_online)
riskratio(d2)

## $data
##                               
##                                  1   2 Total
##   Complete Physical Attendance 441 395   836
##   Work/study from home         151 188   339
##   Total                        592 583  1175
## 
## $measure
##                               risk ratio with 95% C.I.
##                                estimate    lower    upper
##   Complete Physical Attendance 1.000000       NA       NA
##   Work/study from home         1.173728 1.041735 1.322444
## 
## $p.value
##                               two-sided
##                                midp.exact fisher.exact chi.square
##   Complete Physical Attendance         NA           NA         NA
##   Work/study from home         0.01089995   0.01199882 0.01078203
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

epitab(d2, method = "oddsratio")

## $tab
##                               
##                                  1        p0   2      p1 oddsratio    lower
##   Complete Physical Attendance 441 0.7449324 395 0.67753  1.000000       NA
##   Work/study from home         151 0.2550676 188 0.32247  1.390024 1.078669
##                               
##                                   upper    p.value
##   Complete Physical Attendance       NA         NA
##   Work/study from home         1.791251 0.01199882
## 
## $measure
## [1] "wald"
## 
## $conf.level
## [1] 0.95
## 
## $pvalue
## [1] "fisher.exact"

4.4.2.4 Biến prefer và biến home_env

library(epitools)
dh <- table(psyco$prefer, psyco$home_env)
riskratio(dh)

## $data
##                               
##                                  1   2 Total
##   Complete Physical Attendance 395 441   836
##   Work/study from home         160 179   339
##   Total                        555 620  1175
## 
## $measure
##                               risk ratio with 95% C.I.
##                                estimate    lower    upper
##   Complete Physical Attendance  1.00000       NA       NA
##   Work/study from home          1.00097 0.888357 1.127858
## 
## $p.value
##                               two-sided
##                                midp.exact fisher.exact chi.square
##   Complete Physical Attendance         NA           NA         NA
##   Work/study from home          0.9877286            1  0.9873012
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

epitab(dh, method = "oddsratio")

## $tab
##                               
##                                  1        p0   2        p1 oddsratio     lower
##   Complete Physical Attendance 395 0.7117117 441 0.7112903  1.000000        NA
##   Work/study from home         160 0.2882883 179 0.2887097  1.002055 0.7782223
##                               
##                                   upper p.value
##   Complete Physical Attendance       NA      NA
##   Work/study from home         1.290267       1
## 
## $measure
## [1] "wald"
## 
## $conf.level
## [1] 0.95
## 
## $pvalue
## [1] "fisher.exact"

4.4.2.5 Biến relaxed và biến travel_time

library(epitools)
d3 <- table(psyco$relaxed, psyco$travel_time)
riskratio(d3)

## Warning in chisq.test(xx, correct = correction): Chi-squared approximation may
## be incorrect

## $data
##        
##         0.5 1.5 2.5  3 Total
##   -1     64  42  24 14   144
##   -0.5  206  57   2  3   268
##   0     206  82  18  0   306
##   0.5   140  67  63  4   274
##   1      83  95   4  1   183
##   Total 699 343 111 22  1175
## 
## $measure
##       risk ratio with 95% C.I.
##         estimate     lower     upper
##   -1   1.0000000        NA        NA
##   -0.5 0.5469853 0.3937720 0.7598127
##   0    0.7185847 0.5334710 0.9679325
##   0.5  0.8168852 0.6011855 1.1099760
##   1    1.3469770 1.0260223 1.7683309
## 
## $p.value
##       two-sided
##          midp.exact fisher.exact   chi.square
##   -1             NA           NA           NA
##   -0.5 0.0006113543 7.241984e-16 1.690807e-15
##   0    0.0376014697 5.064695e-11 5.691453e-11
##   0.5  0.2065144396 5.225243e-04 3.570631e-04
##   1    0.0257050514 2.481452e-10 1.185593e-09
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

epitab(d3, method = "oddsratio")

## Warning in chisq.test(xx, correct = correction): Chi-squared approximation may
## be incorrect

## $tab
##       
##        0.5         p0 1.5        p1 oddsratio     lower     upper      p.value
##   -1    64 0.09155937  42 0.1224490 1.0000000        NA        NA           NA
##   -0.5 206 0.29470672  57 0.1661808 0.4216366 0.2589864 0.6864355 7.241984e-16
##   0    206 0.29470672  82 0.2390671 0.6065650 0.3806954 0.9664447 5.064695e-11
##   0.5  140 0.20028612  67 0.1953353 0.7292517 0.4485198 1.1856958 5.225243e-04
##   1     83 0.11874106  95 0.2769679 1.7441193 1.0705656 2.8414441 2.481452e-10
## 
## $measure
## [1] "wald"
## 
## $conf.level
## [1] 0.95
## 
## $pvalue
## [1] "fisher.exact"

4.4.2.6 Biến relaxed và biến certaindays_hw

library(epitools)
d4 <- table(psyco$relaxed, psyco$certaindays_hw)
riskratio(d4)

## $data
##        
##          No Yes Total
##   -1     70  74   144
##   -0.5  132 136   268
##   0     153 153   306
##   0.5   123 151   274
##   1      98  85   183
##   Total 576 599  1175
## 
## $measure
##       risk ratio with 95% C.I.
##         estimate     lower    upper
##   -1   1.0000000        NA       NA
##   -0.5 0.9874950 0.8102277 1.203546
##   0    0.9729730 0.8010821 1.181747
##   0.5  1.0724009 0.8855423 1.298689
##   1    0.9038547 0.7236621 1.128915
## 
## $p.value
##       two-sided
##        midp.exact fisher.exact chi.square
##   -1           NA           NA         NA
##   -0.5  0.9016946    0.9179945  0.9009882
##   0     0.7846127    0.8399322  0.7834049
##   0.5   0.4705854    0.4721369  0.4684011
##   1     0.3778292    0.4354085  0.3748576
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

epitab(d4, method = "oddsratio")

## $tab
##       
##         No        p0 Yes        p1 oddsratio     lower    upper   p.value
##   -1    70 0.1215278  74 0.1235392 1.0000000        NA       NA        NA
##   -0.5 132 0.2291667 136 0.2270451 0.9746110 0.6499526 1.461440 0.9179945
##   0    153 0.2656250 153 0.2554257 0.9459459 0.6364763 1.405887 0.8399322
##   0.5  123 0.2135417 151 0.2520868 1.1612832 0.7750889 1.739902 0.4721369
##   1     98 0.1701389  85 0.1419032 0.8204633 0.5298669 1.270432 0.4354085
## 
## $measure
## [1] "wald"
## 
## $conf.level
## [1] 0.95
## 
## $pvalue
## [1] "fisher.exact"

4.4.3 Mô hình logit

prefer = psyco$prefer
easeof_online = psyco$easeof_online
home_env = psyco$home_env
occupation = psyco$occupation
fam_connect = psyco$fam_connect
gender = psyco$gender
certaindays_hw = psyco$certaindays_hw
travel_time = psyco$travel_time
like_hw = psyco$like_hw
dislike_hw = psyco$dislike_hw
mh1 <- glm(data = psyco, formula = factor(prefer) ~ gender + easeof_online + home_env + certaindays_hw + fam_connect + travel_time, family = binomial(link = "logit"))
levels(factor(prefer))

## [1] "Complete Physical Attendance" "Work/study from home"

summary(mh1)

## 
## Call:
## glm(formula = factor(prefer) ~ gender + easeof_online + home_env + 
##     certaindays_hw + fam_connect + travel_time, family = binomial(link = "logit"), 
##     data = psyco)
## 
## Coefficients:
##                   Estimate Std. Error z value Pr(>|z|)    
## (Intercept)       -0.41098    0.33680  -1.220   0.2224    
## genderMale        -1.18570    0.14106  -8.406  < 2e-16 ***
## easeof_online      0.33371    0.13748   2.427   0.0152 *  
## home_env          -0.05008    0.13755  -0.364   0.7158    
## certaindays_hwYes -0.06996    0.13761  -0.508   0.6112    
## fam_connect        0.83118    0.11516   7.217 5.30e-13 ***
## travel_time       -0.57341    0.11063  -5.183 2.18e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 1411.9  on 1174  degrees of freedom
## Residual deviance: 1267.9  on 1168  degrees of freedom
## AIC: 1281.9
## 
## Number of Fisher Scoring iterations: 4

4.4.4 Mô hình probit

mh2 <- glm(data = psyco, formula = factor(prefer) ~ gender + easeof_online + home_env + certaindays_hw + fam_connect + travel_time, family = binomial(link = "probit"))
levels(factor(prefer))

## [1] "Complete Physical Attendance" "Work/study from home"

summary(mh2)

## 
## Call:
## glm(formula = factor(prefer) ~ gender + easeof_online + home_env + 
##     certaindays_hw + fam_connect + travel_time, family = binomial(link = "probit"), 
##     data = psyco)
## 
## Coefficients:
##                   Estimate Std. Error z value Pr(>|z|)    
## (Intercept)       -0.31924    0.19798  -1.612   0.1069    
## genderMale        -0.66299    0.08201  -8.084 6.25e-16 ***
## easeof_online      0.20687    0.08077   2.561   0.0104 *  
## home_env          -0.02718    0.08089  -0.336   0.7369    
## certaindays_hwYes -0.02860    0.08092  -0.353   0.7238    
## fam_connect        0.44838    0.06461   6.940 3.92e-12 ***
## travel_time       -0.29050    0.06230  -4.663 3.12e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 1411.9  on 1174  degrees of freedom
## Residual deviance: 1276.0  on 1168  degrees of freedom
## AIC: 1290
## 
## Number of Fisher Scoring iterations: 5

4.4.5 Mô hình cloglog

mh3 <- glm(data = psyco, formula = factor(prefer) ~ gender + easeof_online + home_env + certaindays_hw + fam_connect + travel_time, family = binomial(link = "cloglog"))
levels(factor(prefer))

## [1] "Complete Physical Attendance" "Work/study from home"

summary(mh3)

## 
## Call:
## glm(formula = factor(prefer) ~ gender + easeof_online + home_env + 
##     certaindays_hw + fam_connect + travel_time, family = binomial(link = "cloglog"), 
##     data = psyco)
## 
## Coefficients:
##                   Estimate Std. Error z value Pr(>|z|)    
## (Intercept)       -0.60296    0.27023  -2.231   0.0257 *  
## genderMale        -1.02745    0.11417  -8.999  < 2e-16 ***
## easeof_online      0.25587    0.11053   2.315   0.0206 *  
## home_env          -0.06445    0.11040  -0.584   0.5594    
## certaindays_hwYes -0.07171    0.11031  -0.650   0.5156    
## fam_connect        0.74055    0.09533   7.768 7.96e-15 ***
## travel_time       -0.49513    0.09143  -5.415 6.12e-08 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 1411.9  on 1174  degrees of freedom
## Residual deviance: 1258.5  on 1168  degrees of freedom
## AIC: 1272.5
## 
## Number of Fisher Scoring iterations: 6

4.5 Lựa chọn mô hình

# Tiêu chí AIC - Akaike Information Criterion
aic1 <- AIC(mh1)
aic2 <- AIC(mh2)
aic3 <- AIC(mh3)
AIC <-cbind(aic1,aic2,aic3)
AIC

##         aic1     aic2     aic3
## [1,] 1281.95 1289.968 1272.519

# Tiêu chí Deviance
de1 <- deviance(mh1)
de2 <- deviance(mh2)
de3 <- deviance(mh3)
deviance <- cbind(de1,de2,de3)
deviance

##          de1      de2      de3
## [1,] 1267.95 1275.968 1258.519

# Tiêu chí Brier Score
bs1 <- BrierScore(mh1)
bs2 <- BrierScore(mh2)
bs3 <- BrierScore(mh3)
BrierScore <- cbind(bs1,bs2,bs3)
BrierScore

##            bs1       bs2       bs3
## [1,] 0.1756904 0.1774658 0.1741582

Dựa vào 3 tiêu chí AIC, Deviance, BrierScore, ta thấy 3 tiêu chí của mô hình cloglog nhỏ nhất, tức là mô hình cloglog là mô hình tốt nhất trong 3 mô hình.

4.6 Giải thích kết quả mô hình

summary(mh3)

## 
## Call:
## glm(formula = factor(prefer) ~ gender + easeof_online + home_env + 
##     certaindays_hw + fam_connect + travel_time, family = binomial(link = "cloglog"), 
##     data = psyco)
## 
## Coefficients:
##                   Estimate Std. Error z value Pr(>|z|)    
## (Intercept)       -0.60296    0.27023  -2.231   0.0257 *  
## genderMale        -1.02745    0.11417  -8.999  < 2e-16 ***
## easeof_online      0.25587    0.11053   2.315   0.0206 *  
## home_env          -0.06445    0.11040  -0.584   0.5594    
## certaindays_hwYes -0.07171    0.11031  -0.650   0.5156    
## fam_connect        0.74055    0.09533   7.768 7.96e-15 ***
## travel_time       -0.49513    0.09143  -5.415 6.12e-08 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 1411.9  on 1174  degrees of freedom
## Residual deviance: 1258.5  on 1168  degrees of freedom
## AIC: 1272.5
## 
## Number of Fisher Scoring iterations: 6

Mô hình hồi quy trong bài được xác định như sau:

\[ \mathrm{cloglog(\pi)} = -0.60296 -1.02745gender + 0.25587easeof_online - -0.06445home_env -0.07171certaindays_hw + 0.74055fam_connect - 0.49513travel_time \] Kết quả phân tích hồi quy Logit cho thấy, 6 biến đưa vào mô hình hồi quy để phân tích nhưng kết quả phân tích chỉ có 4 biến độc lập có ý nghĩa thống kê bao gồm:

gender Giới tính

easeof_online Thích công việc trực tuyến

fam_connect Đánh giá mức độ kết nối của người đó với gia đình

travel_time Thời gian di chuyển

Với giả thuyết các yếu tố khác không đổi, ảnh hưởng của từng biến đến được diễn giải như sau:

easeof_online Thích công việc trực tuyến sẽ có tác động khác nhau đến làm việc tại nhà hay đi học Ở mức ý nghĩa 5%, ước lượng 0.25587 cho biến này cho thấy có mối liên hệ tích tích cực làm việc tại nhà hay đi học

fam_connect Đánh giá mức độ kết nối của người đó với gia đình sẽ có tác động khác nhau đến làm việc tại nhà hay đi học Ở mức ý nghĩa 5%, ước lượng 0.74055 cho biến này cho thấy có mối liên hệ tích tích cực làm việc tại nhà hay đi học

travel_time Thời gian di chuyển sẽ có tác động khác nhau đến làm việc tại nhà hay đi học Ở mức ý nghĩa 5%, ước lượng -0.49513 cho biến này cho thấy có mối liên hệ tích tiêu cực làm việc tại nhà hay đi học

gender Giới tính khác nhau sẽ có tác động khác nhau đến làm việc tại nhà hay đi học Ở mức ý nghĩa 5%, ước lượng -1.02745 cho biến này cho thấy có mối liên hệ tích tiêu cực làm việc tại nhà hay đi học

4.7 Độ chính xác mô hình

library(caret)

## Warning: package 'caret' was built under R version 4.3.1

## Loading required package: lattice

## 
## Attaching package: 'caret'

## The following objects are masked from 'package:DescTools':
## 
##     MAE, RMSE

## The following object is masked from 'package:purrr':
## 
##     lift

### Mô hình cloglog
predictions <- predict(mh3, newdata = psyco, type = "response")
predicted_classes <- ifelse(predictions > 0.5, "1", "0")
predictions1<-factor(predicted_classes, levels = c("0","1"))
actual<- factor(psyco$prefer, labels = c("0","1"))
confusionMatrix(table(predictions1, actual))

## Confusion Matrix and Statistics
## 
##             actual
## predictions1   0   1
##            0 779 213
##            1  57 126
##                                          
##                Accuracy : 0.7702         
##                  95% CI : (0.7451, 0.794)
##     No Information Rate : 0.7115         
##     P-Value [Acc > NIR] : 3.307e-06      
##                                          
##                   Kappa : 0.3516         
##                                          
##  Mcnemar's Test P-Value : < 2.2e-16      
##                                          
##             Sensitivity : 0.9318         
##             Specificity : 0.3717         
##          Pos Pred Value : 0.7853         
##          Neg Pred Value : 0.6885         
##              Prevalence : 0.7115         
##          Detection Rate : 0.6630         
##    Detection Prevalence : 0.8443         
##       Balanced Accuracy : 0.6517         
##                                          
##        'Positive' Class : 0              
## 

Mô hình có 77.02% độ chính xác, có độ nhạy 93.18% và độ hiệu quả là 37.17%

Chương 5: Kết luận

5.1 Kết Luận

Tóm lại, đại dịch COVID-19 đã tạo ra nhiều thách thức và cơ hội cho doanh nghiệp. Những doanh nghiệp linh hoạt và tận dụng được cơ hội kỹ thuật số thường có khả năng thích nghi tốt hơn trong thời kỳ khó khăn này. Trước đại dịch COVID-19:

Môi trường kinh doanh thuận lợi: Trước đại dịch, nền kinh tế có xu hướng tăng trưởng ổn định, doanh nghiệp dễ dàng tiếp cận thị trường và nguồn lực.

Cạnh tranh mạnh mẽ: Doanh nghiệp đối đầu với sự cạnh tranh cao từ cả doanh nghiệp trong và ngoài nước. Hạn chế kỹ thuật số: Trong môi trường kinh doanh trước đại dịch, một số doanh nghiệp có thể chưa khai thác tối đa tiềm năng của công nghệ số và kỹ thuật số. Trong đại dịch COVID-19:

Khủng hoảng kinh tế: Đại dịch COVID-19 đã gây ra khủng hoảng kinh tế toàn cầu, dẫn đến suy thoái kinh tế và mất việc làm. Thích ứng với điều kiện mới: Doanh nghiệp phải thích ứng với các biện pháp phong tỏa, giãn cách xã hội và các hạn chế hoạt động kinh doanh.

Tăng cường kỹ thuật số: Đại dịch đã thúc đẩy sự chuyển đổi kỹ thuật số, khiến nhiều doanh nghiệp tập trung hơn vào phát triển và tiếp cận thị trường trực tuyến. Nhu cầu sản phẩm/dịch vụ thay đổi: Một số lĩnh vực như dịch vụ y tế, chăm sóc sức khỏe, sản phẩm giải trí trực tuyến, giao hàng và dịch vụ trực tuyến tăng trưởng mạnh mẽ, trong khi một số lĩnh vực khác bị ảnh hưởng tiêu cực. Điều kiện làm việc thay đổi: Nhiều công ty đã thúc đẩy hình thức làm việc từ xa để duy trì hoạt động kinh doanh trong đại dịch.

5.2 Kiến nghị

Dựa trên tình hình kinh doanh trong đại dịch COVID-19, dưới đây là một số kiến nghị cho doanh nghiệp:

Đẩy mạnh kỹ thuật số: Tiếp tục đầu tư và tăng cường quá trình chuyển đổi kỹ thuật số trong hoạt động kinh doanh của bạn. Xây dựng một trang web tối ưu và dễ sử dụng, tăng cường mạng xã hội và tiếp cận thị trường trực tuyến để thu hút và duy trì khách hàng trong thời gian khó khăn này.

Đa dạng hóa nguồn thu: Nghiên cứu và mở rộng lĩnh vực kinh doanh hoặc sản phẩm/dịch vụ của bạn để đa dạng hóa nguồn thu. Điều này có thể giúp giảm thiểu tác động của việc suy giảm nhu cầu trong một lĩnh vực cụ thể.

Tập trung vào sự an toàn và y tế: Nếu doanh nghiệp của bạn hoạt động trong các lĩnh vực có liên quan đến sức khỏe, chăm sóc cá nhân hoặc dịch vụ y tế, hãy đảm bảo tuân thủ các quy định về sự an toàn và y tế để bảo vệ khách hàng và nhân viên.

Tối ưu hóa quản lý tài chính: Xem xét và cải thiện quy trình quản lý tài chính của doanh nghiệp. Giảm thiểu các chi phí không cần thiết và tối ưu hóa việc thu hồi tiền nhanh chóng từ khách hàng để cải thiện dòng tiền.

Xây dựng và duy trì quan hệ khách hàng: Tạo sự tin tưởng và tăng cường quan hệ với khách hàng. Tìm hiểu nhu cầu của họ trong thời gian khó khăn và cung cấp giải pháp phù hợp. Cung cấp dịch vụ khách hàng xuất sắc và giải quyết các vấn đề nhanh chóng để duy trì lòng tin của khách hàng.

Nâng cao khả năng thích nghi: Hãy cẩn trọng với các biến đổi trong môi trường kinh doanh và xã hội. Dự đoán và thích nghi nhanh chóng với những thay đổi này để đảm bảo bền vững và phát triển trong tương lai.

Hỗ trợ nhân viên: Tạo điều kiện làm việc an toàn và đảm bảo sức khỏe tinh thần của nhân viên trong thời gian khó khăn. Đưa ra các chương trình hỗ trợ tinh thần và thúc đẩy sự cống hiến của nhân viên trong công việc.

Nắm bắt cơ hội: Hãy tìm kiếm cơ hội mới xuất hiện trong đại dịch, chẳng hạn như thị trường mới, nhu cầu mới hoặc các đối tác tiềm năng. Sẵn lòng thay đổi chiến lược kinh doanh nếu cần thiết để tận dụng những cơ hội này.

Duy trì trách nhiệm xã hội: Trong thời gian khó khăn, doanh nghiệp cũng cần chú trọng đến trách nhiệm xã hội. Hỗ trợ cộng đồng, đóng góp vào việc giảm thiểu tác động tiêu cực của đại dịch và thể hiện sự đồng tình với cộng đồng xung quanh.

Những kiến nghị này sẽ giúp doanh nghiệp vượt qua khó khăn và phát triển bền vững trong và sau đại dịch COVID-19.

Link file PDF bài tiểu luận

file:///D:/Ti%E1%BB%83u%20lu%E1%BA%ADn%20PTDLDT.pdf

Link google drive bộ dữ liệu

https://drive.google.com/drive/folders/1rUqfoVTca2jSDNLE1k0QuerCEKruecD8

Tài liệu kham khảo

T.K.Thanh, T.M.Tường, V.A.L.Duy, Bài giảng Phân tích dữ liệu định tính.