setwd("C:/Work Files/Collaborations/Kendall PCOS/Sebastian Thesis")Sebastian Master’s Thesis
{#{r setup, include=FALSE} #knitr::opts_chunk$set(echo = FALSE, warning = FALSE, message = FALSE)
#install.packages("codebook")
#install.packages("ggmice")library(haven)
library(tidyverse)── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr 1.2.0 ✔ readr 2.1.5
✔ forcats 1.0.0 ✔ stringr 1.5.1
✔ ggplot2 4.0.2 ✔ tibble 3.3.0
✔ lubridate 1.9.4 ✔ tidyr 1.3.1
✔ purrr 1.0.4
── 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 errorslibrary(psych)
Attaching package: 'psych'
The following objects are masked from 'package:ggplot2':
%+%, alphalibrary(lavaan)Warning: package 'lavaan' was built under R version 4.5.3This is lavaan 0.6-21
lavaan is FREE software! Please report any bugs.
Attaching package: 'lavaan'
The following object is masked from 'package:psych':
cor2covlibrary(knitr)
library(kableExtra)
Attaching package: 'kableExtra'
The following object is masked from 'package:dplyr':
group_rowslibrary(apaTables)
library(codebook)Warning: package 'codebook' was built under R version 4.5.3
Attaching package: 'codebook'
The following object is masked from 'package:psych':
bfilibrary("mice")
Attaching package: 'mice'
The following object is masked from 'package:stats':
filter
The following objects are masked from 'package:base':
cbind, rbindlibrary(VIM)Loading required package: colorspace
Loading required package: grid
VIM is ready to use.
Suggestions and bug-reports can be submitted at: https://github.com/statistikat/VIM/issues
Attaching package: 'VIM'
The following object is masked from 'package:datasets':
sleeplibrary(ggmice)Warning: package 'ggmice' was built under R version 4.5.3
Attaching package: 'ggmice'
The following objects are masked from 'package:mice':
bwplot, densityplot, stripplot, xyplotlibrary(naniar)
library(performance)
library(MVN)
Attaching package: 'MVN'
The following object is masked from 'package:psych':
mardiaSebastian_Data <-read_sav("LebelThesisData.sav")N=295 (substantial missingness)
Demographics
Age, Gender, Ethnicity, YearOfStudy,Faculty(meaning school), Political Affiliation, Marital Status, Number of Children
Study Variables
Attitude <– Attitude1 - Attitude5 (Higher Score more positive, Attitude Item 4 reverse coded eating beef is.. 7=desirable)
Subjective Norm <– SubjectiveNorm1 - SubjectiveNorm5 (Higher Score more positive, Reverse Code Item 4)
Perceived Beh. Cntl. <– PerceivedBehavioralControl1 - PerceivedBehavioralControl5 (Higher Score is better, Reverse Code Item 4)
Int. LOC <– ILOC1 - ILOC8 (Higher Score is greater ILOC, Reverse Code Items 4, 6, 7,8)
Intention <– Intention1 - Intention5 (higher score is greater intention,
Environmental Behavior <– PEB1 - PEB5
Seb_Analysis_Data<-Sebastian_Data[,c(11,14:21, 38:42,44:48,50:54, 56:63, 65:69,87:91)]
Seb_Analysis_Data_NA <-na.omit(Seb_Analysis_Data)Seb_Analysis_Data$Attitude4 <- 8 - Seb_Analysis_Data$Attitude4
Seb_Analysis_Data$SubjectiveNorm4 <- 8 - Seb_Analysis_Data$SubjectiveNorm4
Seb_Analysis_Data$PerceivedBehaviouralControl4 <- 8 - Seb_Analysis_Data$PerceivedBehaviouralControl4
Seb_Analysis_Data$Intention4 <- 8- Seb_Analysis_Data$Intention4
Seb_Analysis_Data$PEB4 <- 8 - Seb_Analysis_Data$PEB4
Seb_Analysis_Data$ILOC4<- 7 - Seb_Analysis_Data$ILOC4
Seb_Analysis_Data$ILOC6<- 7 - Seb_Analysis_Data$ILOC6
Seb_Analysis_Data$ILOC7<- 7 - Seb_Analysis_Data$ILOC7
Seb_Analysis_Data$ILOC8<- 7 - Seb_Analysis_Data$ILOC8Seb_Analysis_Data$Attitude <- rowMeans(
Seb_Analysis_Data[, c("Attitude1", "Attitude2", "Attitude3", "Attitude5")],
na.rm = TRUE
)
Seb_Analysis_Data$Subjective_Norm <- rowMeans(
Seb_Analysis_Data[, c("SubjectiveNorm1", "SubjectiveNorm2", "SubjectiveNorm3", "SubjectiveNorm5")],
na.rm = TRUE
)
Seb_Analysis_Data$Perc_Beh_Ctl <- rowMeans(
Seb_Analysis_Data[, c("PerceivedBehaviouralControl1", "PerceivedBehaviouralControl2", "PerceivedBehaviouralControl3", "PerceivedBehaviouralControl5")],
na.rm = TRUE
)
Seb_Analysis_Data$Intention <- rowMeans(
Seb_Analysis_Data[, c("Intention1", "Intention2", "Intention3", "Intention5")],
na.rm = TRUE
)
Seb_Analysis_Data$PEB <- rowMeans(
Seb_Analysis_Data[, c("PEB1", "PEB2", "PEB3", "PEB5")],
na.rm = TRUE
)
Seb_Analysis_Data$ILOC <- rowMeans(
Seb_Analysis_Data[, c("ILOC1", "ILOC2", "ILOC3", "ILOC5")],
na.rm = TRUE
)
Seb_Analysis_Data$ELOC <- rowMeans(
Seb_Analysis_Data[, c("ILOC4", "ILOC6", "ILOC7", "ILOC8")],
na.rm = TRUE
)describe((Seb_Analysis_Data)) vars n mean sd median trimmed mad min
Student_ID* 1 295 112.65 62.37 114.00 113.14 80.06 1
Age 2 254 4.80 1.69 5.00 4.78 1.48 1
Gender 3 254 2.10 0.68 2.00 2.00 0.00 1
Ethnicity 4 254 2.92 2.62 1.00 2.57 0.00 1
YearOfStudy 5 254 3.21 1.39 3.00 3.08 1.48 1
Faculty 6 254 3.11 3.23 1.00 2.58 0.00 1
PoliticalAffiliationsinOntario 7 254 3.48 1.99 3.00 3.48 2.97 1
MaritalStatus 8 254 1.59 1.31 1.00 1.24 0.00 1
NumberOfChildren 9 254 6.54 1.46 7.00 7.00 0.00 1
Attitude1 10 146 6.13 1.44 7.00 6.36 0.00 1
Attitude2 11 146 6.14 1.32 7.00 6.33 1.48 1
Attitude3 12 146 5.76 1.49 6.00 5.92 1.48 1
Attitude4 13 146 1.92 2.09 2.00 1.73 2.97 -1
Attitude5 14 146 5.95 1.42 6.00 6.11 1.48 1
SubjectiveNorm1 15 143 5.68 1.57 6.00 5.90 1.48 1
SubjectiveNorm2 16 143 6.01 1.32 6.00 6.22 1.48 1
SubjectiveNorm3 17 143 5.31 1.70 6.00 5.50 1.48 1
SubjectiveNorm4 18 143 1.92 1.44 1.00 1.69 1.48 0
SubjectiveNorm5 19 143 5.47 1.64 6.00 5.64 1.48 1
PerceivedBehaviouralControl1 20 143 6.09 1.49 7.00 6.36 0.00 1
PerceivedBehaviouralControl2 21 143 6.32 1.31 7.00 6.58 0.00 1
PerceivedBehaviouralControl3 22 143 5.13 1.75 5.00 5.23 2.97 1
PerceivedBehaviouralControl4 23 143 1.88 1.55 1.00 1.57 0.00 0
PerceivedBehaviouralControl5 24 143 5.87 1.58 7.00 6.10 1.48 1
ILOC1 25 143 4.81 1.15 5.00 4.88 1.48 1
ILOC2 26 143 3.68 1.44 4.00 3.63 1.48 1
ILOC3 27 143 4.94 0.98 5.00 4.98 0.00 1
ILOC4 28 143 3.31 1.44 3.00 3.40 1.48 0
ILOC5 29 143 4.99 1.01 5.00 5.04 1.48 1
ILOC6 30 143 3.18 1.36 3.00 3.23 1.48 0
ILOC7 31 143 3.75 1.51 4.00 3.89 1.48 0
ILOC8 32 143 2.97 1.43 3.00 2.98 1.48 0
Intention1 33 143 6.22 1.32 7.00 6.46 0.00 1
Intention2 34 143 6.23 1.40 7.00 6.50 0.00 1
Intention3 35 143 5.36 1.92 6.00 5.61 1.48 1
Intention4 36 143 2.48 1.81 2.00 2.23 1.48 0
Intention5 37 143 5.06 1.85 5.00 5.20 1.48 1
PEB1 38 90 5.36 1.92 6.00 5.61 1.48 1
PEB2 39 90 5.28 1.72 5.00 5.50 1.48 1
PEB3 40 90 4.77 1.90 5.00 4.89 2.22 1
PEB4 41 90 3.77 1.93 4.00 3.74 1.48 0
PEB5 42 90 4.46 1.79 4.00 4.51 2.97 1
Attitude 43 146 5.99 1.01 6.12 6.05 0.93 2
Subjective_Norm 44 143 5.62 1.22 5.75 5.72 0.74 1
Perc_Beh_Ctl 45 143 5.85 1.16 6.00 5.95 1.11 1
Intention 46 143 5.72 1.20 5.75 5.82 1.11 1
PEB 47 90 4.96 1.25 5.00 5.00 1.11 1
ILOC 48 143 4.60 0.90 4.50 4.58 0.74 1
ELOC 49 143 3.30 1.10 3.25 3.40 1.11 0
max range skew kurtosis se
Student_ID* 215 214 -0.05 -1.19 3.63
Age 8 7 0.13 -0.53 0.11
Gender 4 3 1.64 3.33 0.04
Ethnicity 8 7 0.90 -0.90 0.16
YearOfStudy 7 6 0.99 1.51 0.09
Faculty 10 9 1.10 -0.56 0.20
PoliticalAffiliationsinOntario 6 5 0.29 -1.65 0.12
MaritalStatus 5 4 1.96 2.13 0.08
NumberOfChildren 7 6 -3.00 7.37 0.09
Attitude1 8 7 -1.51 1.98 0.12
Attitude2 8 7 -1.40 2.04 0.11
Attitude3 8 7 -0.89 0.33 0.12
Attitude4 7 8 0.51 -0.74 0.17
Attitude5 8 7 -1.11 0.97 0.12
SubjectiveNorm1 8 7 -1.17 1.09 0.13
SubjectiveNorm2 8 7 -1.53 2.84 0.11
SubjectiveNorm3 8 7 -0.81 0.08 0.14
SubjectiveNorm4 7 7 1.56 2.28 0.12
SubjectiveNorm5 8 7 -0.80 0.06 0.14
PerceivedBehaviouralControl1 8 7 -1.62 2.30 0.12
PerceivedBehaviouralControl2 8 7 -1.80 2.93 0.11
PerceivedBehaviouralControl3 8 7 -0.32 -0.92 0.15
PerceivedBehaviouralControl4 7 7 1.80 2.75 0.13
PerceivedBehaviouralControl5 8 7 -1.09 0.36 0.13
ILOC1 7 6 -0.49 0.12 0.10
ILOC2 7 6 0.16 -0.19 0.12
ILOC3 7 6 -0.68 1.84 0.08
ILOC4 6 6 -0.34 -0.17 0.12
ILOC5 7 6 -0.60 1.09 0.08
ILOC6 6 6 -0.20 -0.26 0.11
ILOC7 6 6 -0.73 0.09 0.13
ILOC8 6 6 -0.08 -0.65 0.12
Intention1 8 7 -1.65 2.58 0.11
Intention2 8 7 -1.87 3.40 0.12
Intention3 8 7 -0.86 -0.33 0.16
Intention4 7 7 0.93 -0.01 0.15
Intention5 8 7 -0.44 -0.72 0.15
PEB1 8 7 -0.87 -0.24 0.20
PEB2 8 7 -0.80 0.01 0.18
PEB3 8 7 -0.32 -0.94 0.20
PEB4 7 7 0.10 -0.85 0.20
PEB5 8 7 -0.28 -0.69 0.19
Attitude 8 6 -0.57 0.87 0.08
Subjective_Norm 8 7 -0.94 1.74 0.10
Perc_Beh_Ctl 8 7 -1.03 2.22 0.10
Intention 8 7 -0.91 1.36 0.10
PEB 8 7 -0.26 0.53 0.13
ILOC 7 6 0.04 2.21 0.08
ELOC 6 6 -0.97 1.67 0.09vis_miss(Seb_Analysis_Data[, 43:49])
gg_miss_var(Seb_Analysis_Data[, 43:49])
gg_miss_upset(Seb_Analysis_Data[, 43:49])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.
ℹ The deprecated feature was likely used in the UpSetR package.
Please report the issue to the authors.Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
ℹ Please use `linewidth` instead.
ℹ The deprecated feature was likely used in the UpSetR package.
Please report the issue to the authors.Warning: The `size` argument of `element_line()` is deprecated as of ggplot2 3.4.0.
ℹ Please use the `linewidth` argument instead.
ℹ The deprecated feature was likely used in the UpSetR package.
Please report the issue to the authors.
md.pattern(Seb_Analysis_Data[, 43:49])
Attitude Subjective_Norm Perc_Beh_Ctl Intention ILOC ELOC PEB
71 1 1 1 1 1 1 1 0
72 1 1 1 1 1 1 0 1
3 1 0 0 0 0 0 1 5
16 0 0 0 0 0 0 1 6
133 0 0 0 0 0 0 0 7
149 152 152 152 152 152 205 1114mcar_test(Seb_Analysis_Data[, 43:49])# A tibble: 1 × 4
statistic df p.value missing.patterns
<dbl> <dbl> <dbl> <int>
1 9.03 9 0.434 5describe(Seb_Analysis_Data[, 43:49])%>%
knitr::kable(digits = 3, format="html", booktabs=TRUE, caption="Table 1. Descriptives")%>%
kable_classic(full_width = F, html_font = "Cambria")| vars | n | mean | sd | median | trimmed | mad | min | max | range | skew | kurtosis | se | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Attitude | 1 | 146 | 5.993 | 1.006 | 6.125 | 6.053 | 0.927 | 2 | 8 | 6 | -0.572 | 0.875 | 0.083 |
| Subjective_Norm | 2 | 143 | 5.617 | 1.220 | 5.750 | 5.720 | 0.741 | 1 | 8 | 7 | -0.936 | 1.741 | 0.102 |
| Perc_Beh_Ctl | 3 | 143 | 5.853 | 1.163 | 6.000 | 5.954 | 1.112 | 1 | 8 | 7 | -1.031 | 2.222 | 0.097 |
| Intention | 4 | 143 | 5.717 | 1.200 | 5.750 | 5.824 | 1.112 | 1 | 8 | 7 | -0.906 | 1.359 | 0.100 |
| PEB | 5 | 90 | 4.964 | 1.247 | 5.000 | 4.997 | 1.112 | 1 | 8 | 7 | -0.263 | 0.529 | 0.131 |
| ILOC | 6 | 143 | 4.605 | 0.902 | 4.500 | 4.583 | 0.741 | 1 | 7 | 6 | 0.040 | 2.212 | 0.075 |
| ELOC | 7 | 143 | 3.304 | 1.097 | 3.250 | 3.398 | 1.112 | 0 | 6 | 6 | -0.973 | 1.675 | 0.092 |
apa.cor.table(Seb_Analysis_Data[, 43:49])
Means, standard deviations, and correlations with confidence intervals
Variable M SD 1 2 3
1. Attitude 5.99 1.01
2. Subjective_Norm 5.62 1.22 .76**
[.68, .82]
3. Perc_Beh_Ctl 5.85 1.16 .73** .62**
[.64, .80] [.51, .71]
4. Intention 5.72 1.20 .71** .76** .72**
[.62, .79] [.68, .82] [.63, .79]
5. PEB 4.96 1.25 -.21 -.26* -.18
[-.42, .02] [-.47, -.03] [-.39, .06]
6. ILOC 4.60 0.90 .50** .56** .52**
[.37, .61] [.44, .67] [.39, .63]
7. ELOC 3.30 1.10 -.35** -.42** -.36**
[-.48, -.19] [-.55, -.27] [-.50, -.21]
4 5 6
-.26*
[-.47, -.03]
.50** -.19
[.37, .62] [-.41, .04]
-.41** .25* -.60**
[-.53, -.26] [.02, .46] [-.69, -.48]
Note. M and SD are used to represent mean and standard deviation, respectively.
Values in square brackets indicate the 95% confidence interval.
The confidence interval is a plausible range of population correlations
that could have caused the sample correlation (Cumming, 2014).
* indicates p < .05. ** indicates p < .01.
254/295[1] 0.8610169146/254[1] 0.5748031143/254[1] 0.562992190/254[1] 0.3543307295 - 254[1] 41hist(Seb_Analysis_Data$Attitude)
hist(Seb_Analysis_Data$Subjective_Norm)
hist(Seb_Analysis_Data$Perc_Beh_Ctl)
hist(Seb_Analysis_Data$Intention)
hist(Seb_Analysis_Data$ILOC)
hist(Seb_Analysis_Data$ELOC)
hist(Seb_Analysis_Data$PEB)
alpha’s for scales including Item 4 about beef
Attitude_items_only <- Seb_Analysis_Data[, c("Attitude1", "Attitude2", "Attitude3", "Attitude4", "Attitude5")]
Attitude_alpha_results <- alpha(Attitude_items_only, check.keys = TRUE)Number of categories should be increased in order to count frequencies. Warning in alpha(Attitude_items_only, check.keys = TRUE): Some items were negatively correlated with the first principal component and were automatically reversed.
This is indicated by a negative sign for the variable name.print(Attitude_alpha_results)
Reliability analysis
Call: alpha(x = Attitude_items_only, check.keys = TRUE)
raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
0.67 0.69 0.67 0.31 2.3 0.03 5.8 1 0.32
95% confidence boundaries
lower alpha upper
Feldt 0.61 0.67 0.73
Duhachek 0.61 0.67 0.73
Reliability if an item is dropped:
raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
Attitude1 0.62 0.64 0.60 0.30 1.7 0.036 0.0144 0.29
Attitude2 0.61 0.63 0.59 0.30 1.7 0.037 0.0176 0.30
Attitude3 0.65 0.67 0.63 0.34 2.1 0.032 0.0112 0.34
Attitude4- 0.67 0.67 0.61 0.34 2.1 0.031 0.0023 0.34
Attitude5 0.57 0.61 0.55 0.28 1.5 0.041 0.0112 0.30
Item statistics
n raw.r std.r r.cor r.drop mean sd
Attitude1 146 0.65 0.68 0.57 0.44 6.1 1.4
Attitude2 146 0.66 0.70 0.58 0.48 6.1 1.3
Attitude3 146 0.59 0.62 0.46 0.35 5.8 1.5
Attitude4- 146 0.69 0.62 0.49 0.38 5.1 2.1
Attitude5 146 0.73 0.73 0.65 0.56 5.9 1.4alpha’s for scales without Item 4 about beef
Attitude_items_only <- Seb_Analysis_Data[, c("Attitude1", "Attitude2", "Attitude3", "Attitude5")]
Attitude_alpha_results <- alpha(Attitude_items_only, check.keys = TRUE)
print(Attitude_alpha_results)
Reliability analysis
Call: alpha(x = Attitude_items_only, check.keys = TRUE)
raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
0.67 0.67 0.61 0.34 2.1 0.031 6 1 0.34
95% confidence boundaries
lower alpha upper
Feldt 0.61 0.67 0.73
Duhachek 0.61 0.67 0.73
Reliability if an item is dropped:
raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
Attitude1 0.57 0.58 0.48 0.31 1.4 0.043 0.0016 0.31
Attitude2 0.59 0.59 0.49 0.33 1.4 0.041 0.0028 0.33
Attitude3 0.63 0.63 0.54 0.36 1.7 0.037 0.0023 0.38
Attitude5 0.63 0.63 0.53 0.36 1.7 0.038 0.0016 0.35
Item statistics
n raw.r std.r r.cor r.drop mean sd
Attitude1 146 0.74 0.74 0.61 0.50 6.1 1.4
Attitude2 146 0.71 0.73 0.59 0.48 6.1 1.3
Attitude3 146 0.70 0.69 0.51 0.42 5.8 1.5
Attitude5 146 0.69 0.69 0.52 0.42 5.9 1.4
Non missing response frequency for each item
1 2 3 4 5 6 7 8 miss
Attitude1 0.01 0.03 0.01 0.09 0.10 0.17 0.53 0.05 0.51
Attitude2 0.01 0.02 0.02 0.06 0.14 0.23 0.48 0.05 0.51
Attitude3 0.01 0.01 0.05 0.13 0.14 0.25 0.35 0.05 0.51
Attitude5 0.01 0.03 0.01 0.12 0.14 0.23 0.42 0.05 0.51Subjective Norm
Subjective_Norm_items_only <- Seb_Analysis_Data[, c("SubjectiveNorm1", "SubjectiveNorm2", "SubjectiveNorm3", "SubjectiveNorm5")]
Subjective_Norm_alpha_results <- alpha(Subjective_Norm_items_only, check.keys = TRUE)
print(Subjective_Norm_alpha_results)
Reliability analysis
Call: alpha(x = Subjective_Norm_items_only, check.keys = TRUE)
raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
0.78 0.78 0.74 0.48 3.6 0.02 5.6 1.2 0.49
95% confidence boundaries
lower alpha upper
Feldt 0.74 0.78 0.82
Duhachek 0.75 0.78 0.82
Reliability if an item is dropped:
raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
SubjectiveNorm1 0.68 0.68 0.59 0.41 2.1 0.032 0.0058 0.39
SubjectiveNorm2 0.78 0.78 0.71 0.54 3.6 0.022 0.0036 0.52
SubjectiveNorm3 0.72 0.73 0.64 0.47 2.7 0.027 0.0045 0.49
SubjectiveNorm5 0.74 0.74 0.67 0.48 2.8 0.026 0.0178 0.49
Item statistics
n raw.r std.r r.cor r.drop mean sd
SubjectiveNorm1 143 0.84 0.84 0.79 0.70 5.7 1.6
SubjectiveNorm2 143 0.68 0.71 0.55 0.49 6.0 1.3
SubjectiveNorm3 143 0.80 0.79 0.69 0.61 5.3 1.7
SubjectiveNorm5 143 0.78 0.77 0.65 0.59 5.5 1.6
Non missing response frequency for each item
1 2 3 4 5 6 7 8 miss
SubjectiveNorm1 0.03 0.02 0.03 0.12 0.15 0.28 0.34 0.03 0.52
SubjectiveNorm2 0.01 0.02 0.01 0.06 0.13 0.34 0.39 0.03 0.52
SubjectiveNorm3 0.04 0.05 0.05 0.12 0.22 0.23 0.25 0.03 0.52
SubjectiveNorm5 0.03 0.03 0.06 0.15 0.16 0.24 0.29 0.04 0.52Model_Variables_only <- Seb_Analysis_Data[, c("Attitude", "Subjective_Norm", "Perc_Beh_Ctl", "Intention", "ILOC", "PEB")]
plot_pattern(Model_Variables_only)
mcar_test(Model_Variables_only)# A tibble: 1 × 4
statistic df p.value missing.patterns
<dbl> <dbl> <dbl> <int>
1 6.48 8 0.593 5random <- rnorm(nrow(Seb_Analysis_Data[,(43:48)]), 7)
#The command above generates a random variable with the same number of rows (values)as the dataset
hist(random)#just to check the distribtuion of this new variable
fakereg <-lm(random ~., data = Seb_Analysis_Data[,(43:48)])
##runs a regression with the new random variable as the dv and all the variables in the dataset as IVs
##This generates a set of residuals in order to check the assumptions
##The following set of code just scales the residuals
standardized <- rstudent(fakereg)
fitted <- scale(fakereg$fitted.values)
hist(fitted)
check_model (fakereg) 
MVN::mvn(
Seb_Analysis_Data[, 43:48],
mvn_test = "hz",
B = 1000,
univariate_test = "SW",
multivariate_outlier_method = "quan",
show_new_data = FALSE
)Warning in MVN::mvn(Seb_Analysis_Data[, 43:48], mvn_test = "hz", B = 1000, :
Missing values detected in 224 rows. These rows will be removed.$multivariate_normality
Test Statistic p.value Method MVN
1 Henze-Zirkler 1.054 0.002 asymptotic ✗ Not normal
$univariate_normality
Test Variable Statistic p.value Normality
1 Shapiro-Wilk Attitude 0.882 <0.001 ✗ Not normal
2 Shapiro-Wilk Subjective_Norm 0.851 <0.001 ✗ Not normal
3 Shapiro-Wilk Perc_Beh_Ctl 0.844 <0.001 ✗ Not normal
4 Shapiro-Wilk Intention 0.879 <0.001 ✗ Not normal
5 Shapiro-Wilk PEB 0.989 0.809 ✓ Normal
6 Shapiro-Wilk ILOC 0.930 <0.001 ✗ Not normal
$descriptives
Variable n Mean Std.Dev Median Min Max 25th 75th Skew Kurtosis
1 Attitude 71 5.930 0.974 6.25 2 7 5.500 6.750 -1.331 5.409
2 Subjective_Norm 71 5.532 1.254 5.75 1 7 5.250 6.250 -1.541 5.936
3 Perc_Beh_Ctl 71 5.750 1.221 6.00 1 7 5.250 6.625 -1.613 6.463
4 Intention 71 5.655 1.122 5.75 1 7 5.250 6.375 -1.452 6.146
5 PEB 71 4.894 1.176 5.00 2 8 4.125 5.750 -0.084 2.975
6 ILOC 71 4.521 0.875 4.50 1 7 4.125 5.000 -0.858 6.528
$multivariate_outliers
Observation Mahalanobis.Distance
1 4 109.789
2 3 52.554
3 29 46.197
4 40 46.057
5 53 41.705
6 2 34.298
7 46 33.274
8 61 30.516
9 22 25.708
10 52 24.876
11 55 23.155
12 44 20.986
13 67 20.722
14 17 19.315
15 20 18.331
16 41 18.084
17 14 17.604
18 7 16.477
$data
# A tibble: 71 × 6
Attitude Subjective_Norm Perc_Beh_Ctl Intention PEB ILOC
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 7 7 7 7 5 6
2 2 1.75 2 3 5.25 3
3 4 1.75 2 3 5 2
4 4 1 1 1 6.5 1
5 6.75 6.25 6.5 6.5 4.5 4.5
6 4 4 4 4 5.25 3.5
7 6.5 4.25 6.5 5.75 4.75 4
8 6 5.75 7 5.75 5.5 4.25
9 6 5.5 6.5 6.75 5 4.75
10 6.75 5.5 7 6.25 4.75 4.75
# ℹ 61 more rows
$subset
NULL
$outlierMethod
[1] "quan"
attr(,"class")
[1] "mvn"# Select variables
X <- Seb_Analysis_Data[, 43:48]
# Remove rows with missing values (important)
X <- na.omit(X)
# Mahalanobis distance
center <- colMeans(X)
cov_mat <- cov(X)
md <- mahalanobis(X, center = center, cov = cov_mat)
describe(md) vars n mean sd median trimmed mad min max range skew kurtosis se
X1 1 71 5.92 4.94 4.47 5.09 3.15 0.34 29.64 29.29 2.16 6.28 0.59# Critical value (chi-square cutoff)
cutoff <- qchisq(.975, df = ncol(X))
# Flag outliers
outliers <- which(md > cutoff)
outliers[1] 2 3 4 61outlier_table <- data.frame(
ID = 1:nrow(X),
MD = md,
cutoff = cutoff,
outlier = md > cutoff
)
print(outlier_table) ID MD cutoff outlier
1 1 3.2877074 14.44938 FALSE
2 2 18.0389265 14.44938 TRUE
3 3 15.0266416 14.44938 TRUE
4 4 29.6355357 14.44938 TRUE
5 5 1.1141225 14.44938 FALSE
6 6 4.2837215 14.44938 FALSE
7 7 6.2204377 14.44938 FALSE
8 8 3.2935466 14.44938 FALSE
9 9 2.8903401 14.44938 FALSE
10 10 2.3358079 14.44938 FALSE
11 11 2.7406371 14.44938 FALSE
12 12 2.8986273 14.44938 FALSE
13 13 1.4582569 14.44938 FALSE
14 14 5.5572009 14.44938 FALSE
15 15 7.6852444 14.44938 FALSE
16 16 5.4869901 14.44938 FALSE
17 17 7.4333487 14.44938 FALSE
18 18 3.2861313 14.44938 FALSE
19 19 2.6391548 14.44938 FALSE
20 20 4.4236806 14.44938 FALSE
21 21 4.5967438 14.44938 FALSE
22 22 10.1382399 14.44938 FALSE
23 23 1.4613371 14.44938 FALSE
24 24 4.5701754 14.44938 FALSE
25 25 1.9582338 14.44938 FALSE
26 26 5.1686507 14.44938 FALSE
27 27 7.0342500 14.44938 FALSE
28 28 6.7168363 14.44938 FALSE
29 29 14.0858025 14.44938 FALSE
30 30 2.4936258 14.44938 FALSE
31 31 0.6976865 14.44938 FALSE
32 32 5.1262167 14.44938 FALSE
33 33 3.5295090 14.44938 FALSE
34 34 4.8720009 14.44938 FALSE
35 35 4.1427969 14.44938 FALSE
36 36 4.2013449 14.44938 FALSE
37 37 7.5380143 14.44938 FALSE
38 38 2.2773441 14.44938 FALSE
39 39 6.0236793 14.44938 FALSE
40 40 14.3874032 14.44938 FALSE
41 41 8.0289223 14.44938 FALSE
42 42 8.0073814 14.44938 FALSE
43 43 1.1280464 14.44938 FALSE
44 44 12.1147491 14.44938 FALSE
45 45 4.6900728 14.44938 FALSE
46 46 11.7495797 14.44938 FALSE
47 47 3.0883039 14.44938 FALSE
48 48 1.8949895 14.44938 FALSE
49 49 7.9176000 14.44938 FALSE
50 50 0.3436545 14.44938 FALSE
51 51 1.0703427 14.44938 FALSE
52 52 13.7397965 14.44938 FALSE
53 53 11.7478718 14.44938 FALSE
54 54 1.0920450 14.44938 FALSE
55 55 6.5969758 14.44938 FALSE
56 56 3.3347767 14.44938 FALSE
57 57 3.1032776 14.44938 FALSE
58 58 4.4714150 14.44938 FALSE
59 59 3.8201282 14.44938 FALSE
60 60 4.6910318 14.44938 FALSE
61 61 18.0063496 14.44938 TRUE
62 62 3.8094077 14.44938 FALSE
63 63 4.3279148 14.44938 FALSE
64 64 4.1991910 14.44938 FALSE
65 65 4.2804257 14.44938 FALSE
66 66 6.9213411 14.44938 FALSE
67 67 6.8282357 14.44938 FALSE
68 68 7.9653873 14.44938 FALSE
69 69 4.2605254 14.44938 FALSE
70 70 1.3128651 14.44938 FALSE
71 71 4.7014449 14.44938 FALSEhead(outlier_table) ID MD cutoff outlier
1 1 3.287707 14.44938 FALSE
2 2 18.038927 14.44938 TRUE
3 3 15.026642 14.44938 TRUE
4 4 29.635536 14.44938 TRUE
5 5 1.114123 14.44938 FALSE
6 6 4.283721 14.44938 FALSEplot(md, type = "h",
main = "Mahalanobis Distance (Multivariate Outliers)",
ylab = "D²")
abline(h = cutoff, col = "red", lty = 2)
X <- Seb_Analysis_Data[, 43:48]
z <- scale(X)
describe(z) vars n mean sd median trimmed mad min max range skew
Attitude 1 146 0 1 0.13 0.06 0.92 -3.97 1.99 5.96 -0.57
Subjective_Norm 2 143 0 1 0.11 0.08 0.61 -3.78 1.95 5.74 -0.94
Perc_Beh_Ctl 3 143 0 1 0.13 0.09 0.96 -4.17 1.85 6.02 -1.03
Intention 4 143 0 1 0.03 0.09 0.93 -3.93 1.90 5.83 -0.91
PEB 5 90 0 1 0.03 0.03 0.89 -3.18 2.43 5.61 -0.26
ILOC 6 143 0 1 -0.12 -0.02 0.82 -4.00 2.66 6.65 0.04
kurtosis se
Attitude 0.87 0.08
Subjective_Norm 1.74 0.08
Perc_Beh_Ctl 2.22 0.08
Intention 1.36 0.08
PEB 0.53 0.11
ILOC 2.21 0.08hist(z)
outliers <- which(abs(z) > 3.29, arr.ind = TRUE)
outliers row col
[1,] 16 1
[2,] 18 2
[3,] 16 3
[4,] 17 3
[5,] 18 3
[6,] 18 4
[7,] 18 6boxplot(Seb_Analysis_Data[, 43:48])
ToPB_Model_1 <- '
Intention ~ Attitude + Subjective_Norm + Perc_Beh_Ctl
PEB ~ Intention
'
ToPB_Model_1_fit <- sem(model = ToPB_Model_1, data = Seb_Analysis_Data,
missing = "fiml", mimic = "Mplus")Warning: lavaan->lav_data_full():
152 cases were deleted due to missing values in exogenous variable(s),
while fixed.x = TRUE.summary(ToPB_Model_1_fit, standardized = TRUE, fit.measures = TRUE,rsquare = TRUE)lavaan 0.6-21 ended normally after 13 iterations
Estimator ML
Optimization method NLMINB
Number of model parameters 8
Used Total
Number of observations 143 295
Number of missing patterns 2
Model Test User Model:
Test statistic 0.734
Degrees of freedom 3
P-value (Chi-square) 0.865
Model Test Baseline Model:
Test statistic 168.576
Degrees of freedom 7
P-value 0.000
User Model versus Baseline Model:
Comparative Fit Index (CFI) 1.000
Tucker-Lewis Index (TLI) 1.033
Robust Comparative Fit Index (CFI) 1.000
Robust Tucker-Lewis Index (TLI) 1.063
Loglikelihood and Information Criteria:
Loglikelihood user model (H0) -256.292
Loglikelihood unrestricted model (H1) -255.925
Akaike (AIC) 528.583
Bayesian (BIC) 552.286
Sample-size adjusted Bayesian (SABIC) 526.973
Root Mean Square Error of Approximation:
RMSEA 0.000
90 Percent confidence interval - lower 0.000
90 Percent confidence interval - upper 0.073
P-value H_0: RMSEA <= 0.050 0.915
P-value H_0: RMSEA >= 0.080 0.041
Robust RMSEA 0.000
90 Percent confidence interval - lower 0.000
90 Percent confidence interval - upper 0.106
P-value H_0: Robust RMSEA <= 0.050 0.887
P-value H_0: Robust RMSEA >= 0.080 0.079
Standardized Root Mean Square Residual:
SRMR 0.014
Parameter Estimates:
Standard errors Standard
Information Observed
Observed information based on Hessian
Regressions:
Estimate Std.Err z-value P(>|z|) Std.lv Std.all
Intention ~
Attitude 0.133 0.103 1.281 0.200 0.133 0.108
Subjective_Nrm 0.445 0.073 6.135 0.000 0.445 0.453
Perc_Beh_Ctl 0.371 0.072 5.153 0.000 0.371 0.359
PEB ~
Intention -0.277 0.120 -2.307 0.021 -0.277 -0.282
Intercepts:
Estimate Std.Err z-value P(>|z|) Std.lv Std.all
.Intention 0.251 0.357 0.704 0.482 0.251 0.210
.PEB 6.459 0.691 9.343 0.000 6.459 5.502
Variances:
Estimate Std.Err z-value P(>|z|) Std.lv Std.all
.Intention 0.458 0.054 8.456 0.000 0.458 0.321
.PEB 1.269 0.213 5.958 0.000 1.269 0.921
R-Square:
Estimate
Intention 0.679
PEB 0.079model_1 <-aov(PEB ~ PoliticalAffiliationsinOntario, data=Seb_Analysis_Data)
summary(model_1) Df Sum Sq Mean Sq F value Pr(>F)
PoliticalAffiliationsinOntario 1 0.1 0.0962 0.069 0.794
Residuals 75 105.0 1.3997
218 observations deleted due to missingnessToPB_Model_3 <- '
Perc_Beh_Ctl ~ ILOC + Attitude
Subjective_Norm ~ Attitude + ILOC
Intention ~ Subjective_Norm + Perc_Beh_Ctl
PEB ~ Intention
'
ToPB_Model_3_fit <- sem(model = ToPB_Model_3, data = Seb_Analysis_Data,
missing = "fiml", estimator = "MLR",mimic = "Mplus")Warning: lavaan->lav_data_full():
152 cases were deleted due to missing values in exogenous variable(s),
while fixed.x = TRUE.summary(ToPB_Model_3_fit, standardized = TRUE, fit.measures = TRUE, rsquare = TRUE)lavaan 0.6-21 ended normally after 19 iterations
Estimator ML
Optimization method NLMINB
Number of model parameters 15
Used Total
Number of observations 143 295
Number of missing patterns 2
Model Test User Model:
Standard Scaled
Test Statistic 3.507 3.659
Degrees of freedom 7 7
P-value (Chi-square) 0.834 0.818
Scaling correction factor 0.958
Yuan-Bentler correction (Mplus variant)
Model Test Baseline Model:
Test statistic 426.718 428.194
Degrees of freedom 14 14
P-value 0.000 0.000
Scaling correction factor 0.997
User Model versus Baseline Model:
Comparative Fit Index (CFI) 1.000 1.000
Tucker-Lewis Index (TLI) 1.017 1.016
Robust Comparative Fit Index (CFI) 1.000
Robust Tucker-Lewis Index (TLI) 1.028
Loglikelihood and Information Criteria:
Loglikelihood user model (H0) -583.435 -583.435
Scaling correction factor 1.199
for the MLR correction
Loglikelihood unrestricted model (H1) -581.682 -581.682
Scaling correction factor 1.123
for the MLR correction
Akaike (AIC) 1196.871 1196.871
Bayesian (BIC) 1241.313 1241.313
Sample-size adjusted Bayesian (SABIC) 1193.851 1193.851
Root Mean Square Error of Approximation:
RMSEA 0.000 0.000
90 Percent confidence interval - lower 0.000 0.000
90 Percent confidence interval - upper 0.060 0.065
P-value H_0: RMSEA <= 0.050 0.927 0.913
P-value H_0: RMSEA >= 0.080 0.019 0.025
Robust RMSEA 0.000
90 Percent confidence interval - lower 0.000
90 Percent confidence interval - upper 0.063
P-value H_0: Robust RMSEA <= 0.050 0.930
P-value H_0: Robust RMSEA >= 0.080 0.028
Standardized Root Mean Square Residual:
SRMR 0.021 0.021
Parameter Estimates:
Standard errors Sandwich
Information bread Observed
Observed information based on Hessian
Regressions:
Estimate Std.Err z-value P(>|z|) Std.lv Std.all
Perc_Beh_Ctl ~
ILOC 0.267 0.106 2.516 0.012 0.267 0.207
Attitude 0.743 0.073 10.119 0.000 0.743 0.622
Subjective_Norm ~
Attitude 0.799 0.083 9.604 0.000 0.799 0.638
ILOC 0.332 0.099 3.362 0.001 0.332 0.245
Intention ~
Subjective_Nrm 0.499 0.071 7.020 0.000 0.499 0.511
Perc_Beh_Ctl 0.417 0.074 5.627 0.000 0.417 0.407
PEB ~
Intention -0.277 0.101 -2.752 0.006 -0.277 -0.280
Intercepts:
Estimate Std.Err z-value P(>|z|) Std.lv Std.all
.Perc_Beh_Ctl 0.182 0.537 0.338 0.735 0.182 0.157
.Subjective_Nrm -0.688 0.482 -1.428 0.153 -0.688 -0.565
.Intention 0.476 0.320 1.489 0.137 0.476 0.401
.PEB 6.459 0.526 12.285 0.000 6.459 5.505
Variances:
Estimate Std.Err z-value P(>|z|) Std.lv Std.all
.Perc_Beh_Ctl 0.591 0.092 6.457 0.000 0.591 0.440
.Subjective_Nrm 0.557 0.063 8.862 0.000 0.557 0.376
.Intention 0.463 0.068 6.774 0.000 0.463 0.329
.PEB 1.269 0.230 5.507 0.000 1.269 0.922
R-Square:
Estimate
Perc_Beh_Ctl 0.560
Subjective_Nrm 0.624
Intention 0.671
PEB 0.078parameterEstimates(ToPB_Model_3_fit, standardized=TRUE) %>%
filter(op == "~") %>%
select('Outcome'=lhs, 'Predictor'=rhs, B=est, SE=se, Z=z, 'p-value'=pvalue, Beta=std.all,CI_Lower=ci.lower, CI_Upper=ci.upper) %>%
knitr::kable(digits = 3, format="html", booktabs=TRUE, caption="Total Sample Regressions")%>%
kable_classic(full_width = F, html_font = "Cambria")| Outcome | Predictor | B | SE | Z | p-value | Beta | CI_Lower | CI_Upper |
|---|---|---|---|---|---|---|---|---|
| Perc_Beh_Ctl | ILOC | 0.267 | 0.106 | 2.516 | 0.012 | 0.207 | 0.059 | 0.476 |
| Perc_Beh_Ctl | Attitude | 0.743 | 0.073 | 10.119 | 0.000 | 0.622 | 0.599 | 0.886 |
| Subjective_Norm | Attitude | 0.799 | 0.083 | 9.604 | 0.000 | 0.638 | 0.636 | 0.962 |
| Subjective_Norm | ILOC | 0.332 | 0.099 | 3.362 | 0.001 | 0.245 | 0.138 | 0.526 |
| Intention | Subjective_Norm | 0.499 | 0.071 | 7.020 | 0.000 | 0.511 | 0.359 | 0.638 |
| Intention | Perc_Beh_Ctl | 0.417 | 0.074 | 5.627 | 0.000 | 0.407 | 0.272 | 0.562 |
| PEB | Intention | -0.277 | 0.101 | -2.752 | 0.006 | -0.280 | -0.474 | -0.080 |