Data Clearing
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.3 ✔ readr 2.1.4
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ ggplot2 3.4.3 ✔ tibble 3.2.1
## ✔ lubridate 1.9.2 ✔ tidyr 1.3.0
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ 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
data <- read.csv('data/JL_DisCOVery_Data.csv')
nrow(data)
## [1] 105
summary(data)
## ID age gender gender_4_text
## Min. : 1 Min. :16.00 Min. :1.000 Length:105
## 1st Qu.: 27 1st Qu.:22.00 1st Qu.:2.000 Class :character
## Median : 53 Median :24.00 Median :2.000 Mode :character
## Mean : 53 Mean :24.01 Mean :2.219
## 3rd Qu.: 79 3rd Qu.:26.00 3rd Qu.:2.000
## Max. :105 Max. :35.00 Max. :4.000
##
## highest_qual parent1_education gender_parent1 gender_parent1_4_text
## Min. : 0.000 Min. :1.000 Min. :2.000 Mode:logical
## 1st Qu.: 1.000 1st Qu.:2.000 1st Qu.:2.000 NA's:105
## Median : 3.000 Median :4.000 Median :2.000
## Mean : 3.857 Mean :3.686 Mean :2.286
## 3rd Qu.: 7.000 3rd Qu.:5.000 3rd Qu.:2.000
## Max. :10.000 Max. :7.000 Max. :5.000
## NA's :14
## parent2_education gender_parent2 gender_parent2_4_text employ_status_before
## Min. :1.000 Min. :2.000 Mode:logical Min. : 1.000
## 1st Qu.:2.000 1st Qu.:2.000 NA's:105 1st Qu.: 2.000
## Median :4.000 Median :3.000 Median : 7.000
## Mean :4.314 Mean :2.612 Mean : 6.029
## 3rd Qu.:7.000 3rd Qu.:3.000 3rd Qu.: 8.000
## Max. :7.000 Max. :3.000 Max. :10.000
## NA's :38
## employ_changed employ_industry benefits_before gad_1
## Min. :0.0000 Min. : 2.000 Min. :0.0000 Min. :0.00
## 1st Qu.:0.0000 1st Qu.: 9.000 1st Qu.:0.0000 1st Qu.:1.00
## Median :1.0000 Median : 9.000 Median :0.0000 Median :2.00
## Mean :0.5238 Mean : 9.889 Mean :0.4667 Mean :1.97
## 3rd Qu.:1.0000 3rd Qu.: 9.000 3rd Qu.:1.0000 3rd Qu.:3.00
## Max. :1.0000 Max. :18.000 Max. :1.0000 Max. :3.00
## NA's :78 NA's :5
## gad_2 gad_3 gad_4 gad_5 gad_6
## Min. :0.00 Min. :0.0 Min. :0.00 Min. :0.0 Min. :0.00
## 1st Qu.:1.00 1st Qu.:1.0 1st Qu.:1.00 1st Qu.:0.0 1st Qu.:1.00
## Median :2.00 Median :2.0 Median :2.00 Median :1.0 Median :2.00
## Mean :1.81 Mean :1.9 Mean :1.86 Mean :1.2 Mean :1.74
## 3rd Qu.:3.00 3rd Qu.:3.0 3rd Qu.:3.00 3rd Qu.:2.0 3rd Qu.:3.00
## Max. :3.00 Max. :3.0 Max. :3.00 Max. :3.0 Max. :3.00
## NA's :5 NA's :5 NA's :5 NA's :5 NA's :5
## gad_7 gad_impact
## Min. :0.00 Min. :0.000
## 1st Qu.:0.00 1st Qu.:1.000
## Median :1.00 Median :1.000
## Mean :1.42 Mean :1.561
## 3rd Qu.:3.00 3rd Qu.:2.000
## Max. :3.00 Max. :3.000
## NA's :5 NA's :7
new_data <- data %>% dplyr::select(-gender_parent1, -gender_parent1_4_text, -gender_parent2, -gender_parent2_4_text, -employ_industry, -gender_4_text)
new_data <- new_data %>% dplyr::filter(!is.na(gad_1))
new_data$gender[new_data$gender == 1] <- "Non-Binary"
new_data$gender[new_data$gender == 2] <- "Female"
new_data$gender[new_data$gender == 3] <- "Male"
new_data$gender[new_data$gender == 4] <- "Other"
Descriptive Stats
gender_percentages <- new_data %>%
group_by(gender) %>%
summarise(percentage = n() / nrow(new_data) * 100)
print(gender_percentages)
## # A tibble: 4 × 2
## gender percentage
## <chr> <dbl>
## 1 Female 72
## 2 Male 23
## 3 Non-Binary 4
## 4 Other 1
new_data$age_group <- cut(new_data$age, breaks = c(16, 20, 25, 30, 36),
labels = c("16-20", "21-25", "26-30", "31-36"),
right = FALSE)
# Calculate age group count and percentages using reframe() as per the warning
age_group_summary <- new_data %>%
group_by(age_group) %>%
summarise(
Count = n(),
.groups = 'drop'
) %>%
mutate(
Percentage = Count / sum(Count) * 100
)
print(age_group_summary)
## # A tibble: 4 × 3
## age_group Count Percentage
## <fct> <int> <dbl>
## 1 16-20 7 7
## 2 21-25 52 52
## 3 26-30 34 34
## 4 31-36 7 7
age_stats <- summary(new_data$age)
mean_age <- mean(new_data$age, na.rm = TRUE)
sd_age <- sd(new_data$age, na.rm = TRUE)
min_age <- min(new_data$age, na.rm = TRUE)
max_age <- max(new_data$age, na.rm = TRUE)
n_age <- sum(!is.na(new_data$age))
# Create a summary table for age
age_summary_table <- data.frame(
N = n_age,
Minimum = min_age,
Maximum = max_age,
Mean = mean_age,
Std.Deviation = sd_age
)
# Print the summary table
print("Table 3: Descriptive statistics for age")
## [1] "Table 3: Descriptive statistics for age"
print(age_summary_table)
## N Minimum Maximum Mean Std.Deviation
## 1 100 16 35 24.1 3.641789
Adding Variables
new_data <- dplyr::mutate(new_data,
gad_total = gad_1 + gad_2 + gad_3 + gad_4 + gad_5 + gad_6 + gad_7)
new_data <- new_data %>% dplyr::mutate(., highest_qual = dplyr::recode(highest_qual,`0`= 0, `1`= 1, `2`= 2, `3`= 3, `4` = 3, `5` = 3, `6`= 3, `7` = 4, `8` = 5, `9` = 6, `10` = 7))
new_data <- new_data %>% dplyr::mutate(parent1_education = replace(parent1_education, parent1_education == 7, NA))
new_data <- new_data %>% dplyr::mutate(parent2_education = replace(parent2_education, parent2_education == 7, NA))
print(new_data)
## ID age gender highest_qual parent1_education parent2_education
## 1 1 27 Female 3 5 2
## 2 2 23 Female 3 NA NA
## 3 3 29 Female 4 2 2
## 4 4 18 Female 3 2 1
## 5 5 26 Male 4 3 NA
## 6 6 22 Female 3 5 3
## 7 7 18 Non-Binary 3 2 NA
## 8 8 23 Non-Binary 3 4 4
## 9 9 19 Female 3 5 5
## 10 10 22 Female 4 1 NA
## 11 11 23 Female 6 5 4
## 12 12 23 Female 3 2 NA
## 13 13 21 Female 3 2 NA
## 14 14 21 Female 3 4 2
## 15 15 20 Male 3 4 2
## 16 16 22 Female 1 NA NA
## 17 17 25 Female 3 3 NA
## 18 18 21 Female 3 2 2
## 19 19 23 Female 2 NA NA
## 20 20 22 Female 3 4 3
## 21 21 20 Female 1 5 3
## 22 22 24 Female 1 4 NA
## 23 23 24 Female 4 3 2
## 24 24 18 Female 1 4 6
## 25 25 23 Female 3 3 3
## 26 27 25 Non-Binary 4 4 5
## 27 28 24 Female 3 3 5
## 28 31 25 Female 3 5 5
## 29 32 21 Male 1 3 2
## 30 33 21 Female 3 2 2
## 31 34 20 Female 1 2 1
## 32 35 25 Female 1 1 NA
## 33 36 26 Female 3 4 2
## 34 37 23 Female 3 4 4
## 35 38 34 Female 7 NA NA
## 36 39 24 Female 3 2 NA
## 37 40 20 Male 1 5 NA
## 38 41 22 Male 1 NA NA
## 39 42 27 Female 0 1 1
## 40 43 22 Female 4 5 3
## 41 44 23 Female 4 1 NA
## 42 45 23 Female 3 4 1
## 43 46 21 Female 1 6 NA
## 44 47 24 Other 3 4 3
## 45 48 18 Female 3 5 3
## 46 49 24 Female 3 5 5
## 47 50 20 Male 1 6 6
## 48 51 21 Female 4 4 4
## 49 52 20 Female 1 2 2
## 50 54 25 Male 3 3 3
## 51 55 24 Female 6 3 3
## 52 56 21 Female 3 2 NA
## 53 57 27 Female 6 4 6
## 54 58 22 Female 0 2 2
## 55 59 27 Female 3 NA NA
## 56 60 24 Female 3 2 NA
## 57 61 25 Male 1 3 NA
## 58 62 29 Female 3 4 NA
## 59 63 25 Male 4 2 2
## 60 64 25 Female 1 2 1
## 61 65 20 Male 0 2 2
## 62 66 23 Male 1 3 3
## 63 67 25 Male 1 3 2
## 64 68 23 Male 1 NA NA
## 65 69 23 Female 3 1 NA
## 66 70 25 Male 1 2 NA
## 67 71 22 Male 1 2 1
## 68 72 23 Male 3 5 3
## 69 74 24 Male 1 2 2
## 70 75 25 Male 3 3 3
## 71 76 27 Female 1 2 2
## 72 77 26 Female 3 NA NA
## 73 78 30 Male 1 2 4
## 74 79 27 Female 4 3 2
## 75 80 27 Female 3 NA NA
## 76 81 29 Male 3 2 NA
## 77 82 30 Male 3 4 NA
## 78 83 23 Female 1 2 2
## 79 84 16 Female 0 NA NA
## 80 85 24 Female 1 NA NA
## 81 86 23 Female 4 2 2
## 82 87 25 Male 4 4 1
## 83 88 22 Male 4 4 4
## 84 89 27 Female 3 4 4
## 85 90 27 Female 5 5 3
## 86 91 25 Female 6 4 NA
## 87 92 35 Female 6 2 NA
## 88 93 35 Female 6 NA NA
## 89 94 21 Non-Binary 3 NA NA
## 90 95 19 Female 3 4 3
## 91 96 27 Female 1 3 2
## 92 97 27 Female 1 2 2
## 93 98 24 Female 3 3 1
## 94 99 26 Female 4 3 2
## 95 100 26 Female 5 4 4
## 96 101 29 Female 4 4 NA
## 97 102 27 Female 6 6 6
## 98 103 35 Female 4 3 2
## 99 104 24 Female 6 4 3
## 100 105 30 Female 6 NA NA
## employ_status_before employ_changed benefits_before gad_1 gad_2 gad_3 gad_4
## 1 8 0 1 1 1 1 2
## 2 8 0 1 3 3 3 3
## 3 6 1 1 3 2 3 2
## 4 1 1 1 3 3 3 1
## 5 8 0 1 2 2 2 2
## 6 8 0 1 3 3 3 3
## 7 1 1 1 2 2 2 2
## 8 10 0 0 2 2 2 1
## 9 2 1 1 0 0 0 0
## 10 2 1 0 3 3 3 3
## 11 2 0 0 1 1 1 3
## 12 7 1 0 3 3 3 1
## 13 7 1 0 2 3 3 3
## 14 2 0 0 3 1 2 0
## 15 6 1 0 1 1 1 0
## 16 8 0 1 3 3 3 2
## 17 7 1 0 1 1 1 1
## 18 2 1 0 2 2 2 3
## 19 1 0 1 1 0 0 3
## 20 6 1 0 2 2 2 2
## 21 8 1 1 3 3 3 3
## 22 5 1 0 2 1 1 2
## 23 7 0 0 1 1 1 0
## 24 7 1 0 2 2 2 2
## 25 2 1 0 2 1 2 3
## 26 2 1 0 1 0 0 1
## 27 6 1 1 2 2 2 2
## 28 8 0 1 0 0 0 1
## 29 8 0 1 3 3 3 3
## 30 2 1 0 1 1 0 2
## 31 1 0 0 3 2 2 1
## 32 9 0 1 3 3 3 2
## 33 7 1 0 2 3 3 3
## 34 8 0 1 3 3 3 2
## 35 8 0 0 0 0 0 0
## 36 2 1 0 1 1 1 1
## 37 1 1 0 0 0 0 1
## 38 1 1 0 0 0 0 0
## 39 9 0 1 3 3 3 3
## 40 2 0 0 1 1 1 0
## 41 10 1 0 3 3 3 3
## 42 2 1 0 2 3 3 3
## 43 10 1 1 1 0 3 2
## 44 2 0 0 3 1 2 1
## 45 4 1 1 3 3 3 3
## 46 2 0 1 3 3 3 3
## 47 8 0 1 1 1 1 2
## 48 2 0 0 1 1 1 1
## 49 1 1 1 3 3 3 3
## 50 2 0 0 0 0 0 1
## 51 8 0 0 3 2 2 1
## 52 2 0 0 3 3 3 3
## 53 7 1 0 1 2 2 1
## 54 10 0 1 3 3 3 3
## 55 8 0 1 3 3 3 3
## 56 2 1 0 3 3 3 2
## 57 7 1 0 1 1 1 2
## 58 8 0 1 3 3 3 3
## 59 7 0 0 1 0 1 1
## 60 7 1 1 2 2 2 1
## 61 10 0 1 3 2 2 2
## 62 10 0 1 0 0 0 0
## 63 10 1 1 3 3 3 3
## 64 10 0 1 2 3 3 2
## 65 2 1 0 3 3 3 3
## 66 7 0 0 1 1 1 1
## 67 10 0 1 3 3 3 3
## 68 8 0 1 3 2 3 1
## 69 10 0 1 1 1 1 1
## 70 10 0 1 2 1 2 3
## 71 8 0 1 3 3 3 3
## 72 8 0 1 3 3 3 2
## 73 8 0 1 3 2 2 3
## 74 9 1 1 3 3 3 3
## 75 7 1 0 3 3 3 3
## 76 8 0 1 2 1 1 3
## 77 10 0 1 3 3 3 3
## 78 6 0 0 3 2 2 2
## 79 1 1 0 2 1 3 2
## 80 6 1 1 3 1 1 0
## 81 7 1 0 1 1 0 2
## 82 7 0 0 0 0 1 0
## 83 2 1 0 3 3 3 3
## 84 8 1 1 3 3 3 2
## 85 7 1 0 1 1 1 1
## 86 7 1 0 3 3 3 3
## 87 6 1 1 1 1 1 1
## 88 6 0 0 1 0 1 1
## 89 8 1 1 1 1 1 1
## 90 2 1 0 3 3 3 3
## 91 8 1 1 3 3 3 3
## 92 6 1 0 1 1 1 1
## 93 7 0 0 1 1 1 1
## 94 7 1 0 1 2 2 1
## 95 6 1 0 1 1 1 1
## 96 7 1 0 3 3 3 3
## 97 7 1 0 0 0 0 0
## 98 7 1 0 1 2 1 3
## 99 2 1 0 2 2 1 1
## 100 7 1 0 1 1 0 1
## gad_5 gad_6 gad_7 gad_impact age_group gad_total
## 1 0 0 1 2 26-30 6
## 2 1 2 3 2 21-25 18
## 3 0 2 1 3 26-30 13
## 4 0 1 2 1 16-20 13
## 5 1 1 3 1 26-30 13
## 6 3 3 2 2 21-25 20
## 7 0 1 1 1 16-20 10
## 8 0 2 3 1 21-25 12
## 9 0 1 0 0 16-20 1
## 10 3 3 3 1 21-25 21
## 11 1 1 1 1 21-25 9
## 12 0 2 1 2 21-25 13
## 13 3 3 2 2 21-25 19
## 14 0 3 0 2 21-25 9
## 15 1 0 0 1 21-25 4
## 16 2 3 2 2 21-25 18
## 17 1 1 1 1 26-30 7
## 18 3 2 2 1 21-25 16
## 19 0 1 0 1 21-25 5
## 20 2 3 2 1 21-25 15
## 21 1 3 3 3 21-25 19
## 22 0 1 1 2 21-25 8
## 23 0 1 0 2 21-25 4
## 24 3 3 0 1 16-20 14
## 25 2 1 1 1 21-25 12
## 26 1 0 0 1 26-30 3
## 27 2 0 1 2 21-25 11
## 28 0 1 1 1 26-30 3
## 29 3 2 3 2 21-25 20
## 30 0 1 0 1 21-25 5
## 31 1 1 1 1 21-25 11
## 32 2 3 3 1 26-30 19
## 33 1 3 3 2 26-30 18
## 34 2 2 1 1 21-25 16
## 35 0 0 0 0 31-36 0
## 36 1 2 1 1 21-25 8
## 37 0 0 0 1 21-25 1
## 38 0 0 0 NA 21-25 0
## 39 3 3 3 3 26-30 21
## 40 0 1 0 1 21-25 4
## 41 2 3 3 3 21-25 20
## 42 3 2 3 1 21-25 19
## 43 2 2 2 1 21-25 12
## 44 0 1 0 2 21-25 8
## 45 1 3 3 3 16-20 19
## 46 3 3 3 3 21-25 21
## 47 1 1 0 1 21-25 7
## 48 1 1 0 1 21-25 6
## 49 3 3 3 3 21-25 21
## 50 2 1 1 2 26-30 5
## 51 1 1 1 2 21-25 11
## 52 0 3 2 3 21-25 17
## 53 2 2 2 1 26-30 12
## 54 3 3 3 2 21-25 21
## 55 1 3 3 NA 26-30 19
## 56 2 3 1 1 21-25 17
## 57 0 2 0 1 26-30 7
## 58 3 3 3 3 26-30 21
## 59 0 1 0 1 26-30 4
## 60 1 1 1 0 26-30 10
## 61 2 1 1 1 21-25 13
## 62 0 0 0 0 21-25 0
## 63 3 1 2 1 26-30 18
## 64 1 2 3 1 21-25 16
## 65 1 3 3 3 21-25 19
## 66 1 1 1 1 26-30 7
## 67 2 3 3 3 21-25 20
## 68 0 2 2 2 21-25 13
## 69 1 1 1 3 21-25 7
## 70 3 2 0 1 26-30 13
## 71 3 3 3 3 26-30 21
## 72 3 2 2 3 26-30 18
## 73 0 1 1 3 31-36 12
## 74 3 2 3 2 26-30 20
## 75 3 1 2 1 26-30 18
## 76 3 3 3 3 26-30 16
## 77 1 1 2 2 31-36 16
## 78 0 3 3 3 21-25 15
## 79 1 2 0 2 16-20 11
## 80 0 1 1 1 21-25 7
## 81 2 2 1 1 21-25 9
## 82 0 0 0 0 26-30 1
## 83 1 3 3 3 21-25 19
## 84 2 2 3 1 26-30 18
## 85 0 0 0 1 26-30 4
## 86 2 3 3 3 26-30 20
## 87 0 2 0 1 31-36 6
## 88 0 1 0 0 31-36 4
## 89 0 3 0 2 21-25 7
## 90 3 3 3 2 16-20 21
## 91 3 3 3 3 26-30 21
## 92 0 1 0 0 26-30 5
## 93 1 0 0 0 21-25 5
## 94 0 3 0 1 26-30 9
## 95 0 1 1 2 26-30 6
## 96 1 2 2 2 26-30 17
## 97 0 0 0 0 26-30 0
## 98 0 1 1 2 31-36 9
## 99 0 3 0 1 21-25 9
## 100 0 1 0 0 31-36 4
Visualising Data
GGally::ggscatmat(new_data, columns = c("highest_qual", "parent1_education", "parent2_education", "gad_total")) +
theme_minimal()
## Registered S3 method overwritten by 'GGally':
## method from
## +.gg ggplot2
## Warning: The dot-dot notation (`..scaled..`) was deprecated in ggplot2 3.4.0.
## ℹ Please use `after_stat(scaled)` instead.
## ℹ The deprecated feature was likely used in the GGally package.
## Please report the issue at <https://github.com/ggobi/ggally/issues>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
## Warning: Removed 14 rows containing non-finite values (`stat_density()`).
## Warning: Removed 37 rows containing non-finite values (`stat_density()`).
new_data |>
dplyr::select(highest_qual, gad_total) |>
correlation::correlation() |>
knitr::kable(digits = 3)
| Parameter1 | Parameter2 | r | CI | CI_low | CI_high | t | df_error | p | Method | n_Obs |
|---|---|---|---|---|---|---|---|---|---|---|
| highest_qual | gad_total | -0.242 | 0.95 | -0.418 | -0.047 | -2.464 | 98 | 0.015 | Pearson correlation | 100 |
new_data |>
dplyr::select(parent1_education, gad_total) |>
correlation::correlation() |>
knitr::kable(digits = 3)
| Parameter1 | Parameter2 | r | CI | CI_low | CI_high | t | df_error | p | Method | n_Obs |
|---|---|---|---|---|---|---|---|---|---|---|
| parent1_education | gad_total | -0.264 | 0.95 | -0.451 | -0.056 | -2.512 | 84 | 0.014 | Pearson correlation | 86 |
new_data |>
dplyr::select(parent2_education, gad_total) |>
correlation::correlation() |>
knitr::kable(digits = 3)
| Parameter1 | Parameter2 | r | CI | CI_low | CI_high | t | df_error | p | Method | n_Obs |
|---|---|---|---|---|---|---|---|---|---|---|
| parent2_education | gad_total | -0.196 | 0.95 | -0.423 | 0.055 | -1.557 | 61 | 0.125 | Pearson correlation | 63 |
Fitting the Multiple Regression Model
data_full_lm <- lm(gad_total ~ highest_qual + parent1_education + parent2_education, data = new_data, na.action = na.exclude)
print(data_full_lm)
##
## Call:
## lm(formula = gad_total ~ highest_qual + parent1_education + parent2_education,
## data = new_data, na.action = na.exclude)
##
## Coefficients:
## (Intercept) highest_qual parent1_education parent2_education
## 16.932706 -1.495067 0.004659 -0.384166
broom::glance(data_full_lm) |>
knitr::kable(digits = 3)
| r.squared | adj.r.squared | sigma | statistic | p.value | df | logLik | AIC | BIC | deviance | df.residual | nobs |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 0.157 | 0.114 | 6.118 | 3.655 | 0.017 | 3 | -201.438 | 412.876 | 423.592 | 2208.612 | 59 | 63 |
#Model paramter estimates
broom::tidy(data_full_lm, conf.int = TRUE) |>
knitr::kable(digits = 3)
| term | estimate | std.error | statistic | p.value | conf.low | conf.high |
|---|---|---|---|---|---|---|
| (Intercept) | 16.933 | 2.408 | 7.031 | 0.000 | 12.114 | 21.751 |
| highest_qual | -1.495 | 0.551 | -2.715 | 0.009 | -2.597 | -0.393 |
| parent1_education | 0.005 | 0.877 | 0.005 | 0.996 | -1.750 | 1.760 |
| parent2_education | -0.384 | 0.722 | -0.532 | 0.596 | -1.828 | 1.060 |