## global variables
runIRTmodels <- FALSE
runMplusLCA <- FALSE
## set to lower values to reduce compilation time:
nRep_def = 100 # 100
n.lambda_def = 40 # 40
LCArunsDef = 8 # 10Data analysis - Soft Robot Walker Study
1 Notes
2 global variables
Define your global variables (can take some time to run):
3 load raw data
# sets the directory of location of this script as the current directory
# setwd(dirname(rstudioapi::getSourceEditorContext()$path))
### load packages
require(pacman)
p_load('tidyverse', 'jsonlite',
'stargazer', 'DT', 'psych',
'writexl', 'moments', 'lavaan', 'semPlot', 'mirt', 'MplusAutomation',
'afex', 'emmeans', 'jtools',
'car',
'text2sdg', 'sentimentr')
setwd("../01_dataPreperation/outputs")
dat <- read_rds(file = "questionnaire.rds")
### load functions
setwd("../../../functions")
for(i in 1:length(dir())){
# print(dir()[i])
source(dir()[i], encoding = "utf-8")
}
rm(i)
### summary function
data_summary <- function(data, varname, groupnames){
require(plyr)
summary_func <- function(x, col){
c(mean = mean(x[[col]], na.rm=TRUE),
se = sd(x[[col]], na.rm=TRUE) / sqrt(length(x[[col]])))
}
data_sum<-ddply(data, groupnames, .fun=summary_func,
varname)
data_sum <- plyr::rename(data_sum, c("mean" = varname))
return(data_sum)
}4 Remove persons how participants two times
tmp <- names(table(dat$PROLIFIC_PID))[table(dat$PROLIFIC_PID) >= 2]
tmp; length(tmp)character(0)[1] 0dat[dat$PROLIFIC_PID %in% tmp[1],] [1] ID meta.userAgent
[3] meta.platform meta.language
[5] meta.locale meta.timeZone
[7] meta.timezoneOffset meta.screen_width
[9] meta.screen_height meta.scroll_width
[11] meta.scroll_height meta.window_innerWidth
[13] meta.window_innerHeight meta.devicePixelRatio
[15] PROLIFIC_PID framingCondition
[17] sociodemo_gender sociodemo_priorExperience
[19] sociodemo_residency sociodemo_education
[21] feedback_critic attCheck_text
[23] sociodemo_universityAffiliation sociodemo_universityField
[25] reflection_ecological reflection_social
[27] reflection_economic EcologicalDimension-1
[29] EcologicalDimension-3 EcologicalDimension-4
[31] EcologicalDimension-2 Bioinspiration-VRtN1
[33] Bioinspiration-PN4 Bioinspiration-VRtN4r
[35] Bioinspiration-IPI1 Bioinspiration-PN2r
[37] Bioinspiration-VRtN2 Bioinspiration-IPI2r
[39] Bioinspiration-PN3 Bioinspiration-IPI3
[41] Bioinspiration-IPI4 Bioinspiration-VRtN3
[43] Bioinspiration-PN1 evalInf-6
[45] evalInf-5 evalInf-8
[47] evalInf-2 evalInf-3
[49] evalInf-4 evalInf-10
[51] evalInf-7 evalInf-1
[53] evalInf-9 excitingDesign
[55] entertainingDesign boringDesign
[57] usefulDesign unnecessaryDesign
[59] unimportantDesign excitingTopic
[61] entertainingTopic boringTopic
[63] usefulTopic unnecessaryTopic
[65] unimportantTopic GAToRS-4pp
[67] GAToRS-3sp GAToRS-4pn
[69] GAToRS-5pp GAToRS-1pp
[71] GAToRS-3pp GAToRS-4sp
[73] GAToRS-2pn GAToRS-2sp
[75] GAToRS-1sn GAToRS-3pn
[77] GAToRS-5pn GAToRS-1pn
[79] GAToRS-4sn GAToRS-5sn
[81] GAToRS-5sp GAToRS-2pp
[83] GAToRS-1sp GAToRS-3sn
[85] GAToRS-2sn dummy_informedconsent
[87] commCheck feedback_conscientiousCompletion
[89] sociodemo_age whichItemsFirst
[91] socio_age socio_sex
[93] socio_ethnicity socio_student
[95] socio_employment total_min_prolific
<0 Zeilen> (oder row.names mit Länge 0)## keep only first participation
keep_rows <- do.call(rbind, lapply(tmp, function(id) {
rows <- dat[dat$PROLIFIC_PID == id, ]
rows[which.min(as.numeric(rownames(rows))), , drop = FALSE]
}))
nrow(dat)[1] 298dat <- dat[!dat$PROLIFIC_PID %in% tmp, ]
dat <- rbind(dat, keep_rows)
nrow(dat)[1] 2985 Descriptive Statistics
To describe sample:
psych::describe(dat[, c("sociodemo_age")]) vars n mean sd median trimmed mad min max range skew kurtosis se
X1 1 298 47.08 15.32 49 47.2 17.79 19 84 65 -0.09 -1.09 0.89table(dat$sociodemo_gender)
female male nonbinary none
153 143 1 1 table(dat$sociodemo_gender) / nrow(dat)
female male nonbinary none
0.513422819 0.479865772 0.003355705 0.003355705 prop.table(table(dat$sociodemo_gender))
female male nonbinary none
0.513422819 0.479865772 0.003355705 0.003355705 table(dat$sociodemo_priorExperience)
no not_sure yes_some yes_well
238 17 37 6 table(dat$sociodemo_priorExperience) / nrow(dat)
no not_sure yes_some yes_well
0.79865772 0.05704698 0.12416107 0.02013423 table(dat$socio_sex) # from Prolific
Female Male
155 143 table(dat$socio_sex, dat$sociodemo_gender)
female male nonbinary none
Female 153 1 0 1
Male 0 142 1 0table(dat$socio_employment)
DATA_EXPIRED
28
Due to start a new job within the next month
4
Full-Time
131
Not in paid work (e.g. homemaker', 'retired or disabled)
55
Other
10
Part-Time
54
Unemployed (and job seeking)
16 table(dat$socio_ethnicity)
Asian Black Mixed Other White
23 9 11 8 247 To describe study conditions:
table(dat$framingCondition)
bio-inspired tech-inspired
160 138 To describe length of study:
psych::describe(dat[, c("total_min_prolific")]) vars n mean sd median trimmed mad min max range skew kurtosis se
X1 1 298 27.63 9.62 24.98 26.21 6.98 14.65 75.57 60.92 1.72 3.92 0.56hist(dat$total_min_prolific)
abline(v = mean(dat$total_min_prolific))
To describe conditions:
table(dat$framingCondition, dat$whichItemsFirst)
bioinspired sustainable
bio-inspired 78 82
tech-inspired 77 615.1 Check for differences between conditions
## -----------------------------
## Descriptive statistics
## -----------------------------
# Age
mean(dat$sociodemo_age, na.rm = TRUE)[1] 47.08389sd(dat$sociodemo_age, na.rm = TRUE)[1] 15.31893summary(dat$sociodemo_age) # includes median Min. 1st Qu. Median Mean 3rd Qu. Max.
19.00 33.00 49.00 47.08 60.00 84.00 # Gender counts + proportions
table(dat$sociodemo_gender)
female male nonbinary none
153 143 1 1 prop.table(table(dat$sociodemo_gender))
female male nonbinary none
0.513422819 0.479865772 0.003355705 0.003355705 # Prior experience counts + proportions
table(dat$sociodemo_priorExperience)
no not_sure yes_some yes_well
238 17 37 6 prop.table(table(dat$sociodemo_priorExperience))
no not_sure yes_some yes_well
0.79865772 0.05704698 0.12416107 0.02013423 ## -----------------------------
## Check for differences between framing conditions
## -----------------------------
# 1. Age differences across conditions (ANOVA)
anova_age <- aov(sociodemo_age ~ framingCondition, data = dat)
summary(anova_age) Df Sum Sq Mean Sq F value Pr(>F)
framingCondition 1 50 49.53 0.21 0.647
Residuals 296 69647 235.30 # Also check assumptions
shapiro.test(residuals(anova_age))
Shapiro-Wilk normality test
data: residuals(anova_age)
W = 0.95851, p-value = 1.702e-07car::leveneTest(sociodemo_age ~ framingCondition, data = dat) # requires car packageLevene's Test for Homogeneity of Variance (center = median)
Df F value Pr(>F)
group 1 0.0119 0.9133
296 # 2. Gender differences across conditions (Chi-square)
gender_table <- table(dat$framingCondition, dat$sociodemo_gender)
chisq.test(gender_table)Warning in chisq.test(gender_table): Chi-Quadrat-Approximation kann inkorrekt
sein
Pearson's Chi-squared test
data: gender_table
X-squared = 1.8882, df = 3, p-value = 0.5959# 3. Prior experience differences across conditions (Chi-square)
experience_table <- table(dat$framingCondition, dat$sociodemo_priorExperience)
chisq.test(experience_table)Warning in chisq.test(experience_table): Chi-Quadrat-Approximation kann
inkorrekt sein
Pearson's Chi-squared test
data: experience_table
X-squared = 4.3901, df = 3, p-value = 0.22235.2 remove participants with insufficient effort responding (IER)
insufficient effort responding: respondents provide careless or random responses to survey items
5.2.1 IER: set up dataset
dat_IER <- data.frame(PROLIFIC_PID = dat$PROLIFIC_PID)
#### slow persons total duration
dat_IER$slowTD <- 0
out <- boxplot.stats(dat$total_min_prolific)$out
out_ind <- which(dat$total_min_prolific %in% c(out))
dat_IER$slowTD[dat_IER$PROLIFIC_PID %in% dat$PROLIFIC_PID[out_ind]] <- 1
#### careless respondents based on
# > intra-individual response variability
# > zero SD (all answers equal)
# > Mahalanobis distance (multivariate outliers)
# > compute SD over rows
rowVars <- function(x, na.rm=FALSE) {
# Vectorised version of variance filter
rowSums((x - rowMeans(x, na.rm=na.rm))^2, na.rm=na.rm) / (ncol(x) - 1)
}
scales_regEX <- c("^EcologicalDimension",
"Bioinspiration.*PN",
"Bioinspiration.*VRtN",
"Bioinspiration.*IPI",
"^GAToRS.*pp$",
"^GAToRS.*pn$",
"^GAToRS.*sp$",
"^GAToRS.*sn$")
mat_IIRV <- matrix(data = 0, nrow = nrow(dat), ncol = length(scales_regEX)+1)
mat_IIRV[,1] <- dat$PROLIFIC_PID
mat_zero <- matrix(data = 0, nrow = nrow(dat), ncol = length(scales_regEX)+1)
mat_zero[,1] <- dat$PROLIFIC_PID
mat_MD <- matrix(data = 0, nrow = nrow(dat), ncol = length(scales_regEX)+1)
mat_MD[,1] <- dat$PROLIFIC_PID
h = 2
for(e in scales_regEX){
tmp <- dat[, str_subset(string = colnames(dat), pattern = e)]
tmp <- tmp[, str_subset(string = colnames(tmp), pattern = "^mean_", negate = TRUE)]
## by intra-individual response variability
tmp_SD <- sqrt(rowVars(tmp))
out <- boxplot.stats(tmp_SD)$out
mat_IIRV[,h][mat_IIRV[,1] %in% dat$PROLIFIC_PID[tmp_SD %in% out]] <- 1
## zero SD (all answers equal)
mat_zero[,h][mat_zero[,1] %in% dat$PROLIFIC_PID[tmp_SD == 0]] <- 1
## by Mahalanobis distance (multivariate outliers)
tmp$mahal <- mahalanobis(tmp, colMeans(tmp), cov(tmp))
tmp$p_mahal <- pchisq(tmp$mahal, df=ncol(tmp)-2, lower.tail=FALSE)
mat_MD[,h][mat_MD[,1] %in% dat$PROLIFIC_PID[tmp$p_mahal %in% tmp$p_mahal[tmp$p_mahal < .001]]] <- 1
h = h + 1
}
labels <- str_replace_all(string = scales_regEX, pattern = "\\W+", replacement = "")
dat_IIRV <- as.data.frame(mat_IIRV)
colnames(dat_IIRV) <- c("PROLIFIC_PID",
labels)
dat_zero <- as.data.frame(mat_zero)
colnames(dat_zero) <- c("PROLIFIC_PID",
labels)
dat_MD <- as.data.frame(mat_MD)
colnames(dat_MD) <- c("PROLIFIC_PID",
labels)
dat_IIRV[,labels] <- lapply(dat_IIRV[,labels], as.numeric)
dat_zero[,labels] <- lapply(dat_zero[,labels], as.numeric)
dat_MD[,labels] <- lapply(dat_MD[,labels], as.numeric)
## ADD by intra-individual response variability
table(rowSums(dat_IIRV[,labels]))
0 1 2 3
268 27 2 1 tmp <- rowSums(dat_IIRV[,labels]) >= 3
dat_IER$IIRV <- 0
dat_IER$IIRV[dat_IER$PROLIFIC_PID %in% dat_IIRV$PROLIFIC_PID[tmp]] <- 1
## ADD zero SD (all answers equal)
table(rowSums(dat_zero[,labels]))
0 1 2 3 4 5 6 7 8
131 98 41 19 4 2 1 1 1 tmp <- rowSums(dat_zero[,labels]) >= 3
dat_IER$zero <- 0
dat_IER$zero[dat_IER$PROLIFIC_PID %in% dat_zero$PROLIFIC_PID[tmp]] <- 1
## ADD by Mahalanobis distance (multivariate outliers)
table(rowSums(dat_MD[,labels]))
0 1 2 3
248 43 6 1 tmp <- rowSums(dat_MD[,labels]) >= 2
dat_IER$MD <- 0
dat_IER$MD[dat_IER$PROLIFIC_PID %in% dat_MD$PROLIFIC_PID[tmp]] <- 15.2.2 IER: investigate
sum(rowSums(dat_IER[,2:ncol(dat_IER)]) >= 2)[1] 7dat_IER[rowSums(dat_IER[,2:ncol(dat_IER)]) >= 2,] PROLIFIC_PID slowTD IIRV zero MD
3 5bb7b83ab791890001f4fd90 1 0 1 0
21 5ace82e135eccf0001a11c96 0 0 1 1
34 682b3f63d0e2c4eff64fe664 1 0 1 0
65 5718a9c4dd9ef10013df01f0 0 1 0 1
126 665ba5fad0a8c603ab8b5242 1 0 1 1
158 6730dedb32982b0bdf64d9c2 1 0 1 0
188 664de718b933e68528f6a979 1 0 0 1## flag to delete
tmp_IDs <- dat_IER$PROLIFIC_PID[rowSums(dat_IER[,2:ncol(dat_IER)]) >= 2]
dat$flagDelete <- 0
dat$flagDelete[dat$PROLIFIC_PID %in% tmp_IDs] <- 1
dat[dat$flagDelete == 1, str_subset(string = colnames(dat), pattern = "^EcologicalDimension")] EcologicalDimension-1 EcologicalDimension-3 EcologicalDimension-4
3 7 7 5
21 2 3 2
34 6 7 4
65 5 6 5
126 7 7 7
158 7 7 7
188 7 7 6
EcologicalDimension-2
3 7
21 5
34 7
65 6
126 7
158 7
188 2 dat[dat$flagDelete == 1, str_subset(string = colnames(dat), pattern = "^Bioinspiration.")] Bioinspiration-VRtN1 Bioinspiration-PN4 Bioinspiration-VRtN4r
3 5 5 7
21 1 1 4
34 3 6 6
65 1 3 6
126 7 6 7
158 6 6 7
188 6 6 6
Bioinspiration-IPI1 Bioinspiration-PN2r Bioinspiration-VRtN2
3 7 5 4
21 6 7 5
34 6 1 6
65 7 4 6
126 7 2 6
158 7 6 7
188 7 5 6
Bioinspiration-IPI2r Bioinspiration-PN3 Bioinspiration-IPI3
3 7 3 7
21 6 1 6
34 6 5 6
65 7 5 7
126 7 7 7
158 7 6 7
188 5 6 3
Bioinspiration-IPI4 Bioinspiration-VRtN3 Bioinspiration-PN1
3 7 6 3
21 6 4 1
34 6 7 5
65 7 6 4
126 7 7 7
158 7 7 6
188 6 6 6after visual inspection no removal of participants
6 Evaluation Scales
6.1 Overall EFA PES, PBS
Promax rotation, factoring method minimum residual, if scale is a likert scale less or equal than 7 answering options the EFA or parallel analysis is computed over a polychoric correlation to account for non-normality of data (see in detail R-Code “helperFunctions”)
#### Overall EFA
regExOverall <- "^Bioinspiration|^EcologicalDimension"
psych::cor.plot(r = cor(dat[, str_detect(string = colnames(dat),
pattern = regExOverall)]
, use = "pairwise.complete.obs"),
upper = FALSE, xlas = 2, main = "Overall")
#> parallel analysis
tmp_parallelAnalysis <- dimensionalityTest(label = "Overall",
regEx = regExOverall, dataset = dat)Warning in fa.stats(r = r, f = f, phi = phi, n.obs = n.obs, np.obs = np.obs, :
The estimated weights for the factor scores are probably incorrect. Try a
different factor score estimation method.
Warning in fa.stats(r = r, f = f, phi = phi, n.obs = n.obs, np.obs = np.obs, :
The estimated weights for the factor scores are probably incorrect. Try a
different factor score estimation method.
Parallel analysis suggests that the number of factors = 3 and the number of components = 3
Overall
Number of components: 3 #> EFA
tmp_EFA <- explorativeFactorAnalysis(label = "Overall",
regEx = regExOverall,
dataset = dat, nfac = tmp_parallelAnalysis$nfact)Warning in fa.stats(r = r, f = f, phi = phi, n.obs = n.obs, np.obs = np.obs, :
The estimated weights for the factor scores are probably incorrect. Try a
different factor score estimation method.tmp_EFA[[1]]Factor Analysis using method = minres
Call: fa(r = tmp_dat, nfactors = nfac, rotate = "promax", cor = "cor")
Standardized loadings (pattern matrix) based upon correlation matrix
MR2 MR1 MR3 h2 u2 com
EcologicalDimension-1 -0.05 0.13 0.80 0.71 0.29 1.1
EcologicalDimension-3 0.15 -0.12 0.83 0.69 0.31 1.1
EcologicalDimension-4 -0.09 0.17 0.62 0.47 0.53 1.2
EcologicalDimension-2 0.06 -0.12 0.89 0.74 0.26 1.0
Bioinspiration-VRtN1 -0.08 0.84 -0.03 0.65 0.35 1.0
Bioinspiration-PN4 -0.05 0.66 0.10 0.48 0.52 1.1
Bioinspiration-VRtN4r 0.58 0.27 -0.11 0.48 0.52 1.5
Bioinspiration-IPI1 0.86 -0.07 0.07 0.74 0.26 1.0
Bioinspiration-PN2r -0.02 -0.32 0.00 0.11 0.89 1.0
Bioinspiration-VRtN2 0.41 0.49 -0.03 0.55 0.45 1.9
Bioinspiration-IPI2r 0.58 -0.26 -0.03 0.29 0.71 1.4
Bioinspiration-PN3 -0.10 0.84 0.00 0.66 0.34 1.0
Bioinspiration-IPI3 0.78 0.01 0.02 0.63 0.37 1.0
Bioinspiration-IPI4 0.75 0.00 0.09 0.62 0.38 1.0
Bioinspiration-VRtN3 0.61 0.24 0.03 0.56 0.44 1.3
Bioinspiration-PN1 0.01 0.85 -0.05 0.70 0.30 1.0
MR2 MR1 MR3
SS loadings 3.27 3.24 2.56
Proportion Var 0.20 0.20 0.16
Cumulative Var 0.20 0.41 0.57
Proportion Explained 0.36 0.36 0.28
Cumulative Proportion 0.36 0.72 1.00
With factor correlations of
MR2 MR1 MR3
MR2 1.00 0.38 0.32
MR1 0.38 1.00 0.46
MR3 0.32 0.46 1.00
Mean item complexity = 1.2
Test of the hypothesis that 3 factors are sufficient.
df null model = 120 with the objective function = 8.49 with Chi Square = 2470.08
df of the model are 75 and the objective function was 0.46
The root mean square of the residuals (RMSR) is 0.03
The df corrected root mean square of the residuals is 0.04
The harmonic n.obs is 298 with the empirical chi square 61.37 with prob < 0.87
The total n.obs was 298 with Likelihood Chi Square = 133.96 with prob < 3.4e-05
Tucker Lewis Index of factoring reliability = 0.96
RMSEA index = 0.051 and the 90 % confidence intervals are 0.037 0.065
BIC = -293.32
Fit based upon off diagonal values = 0.99
Measures of factor score adequacy
MR2 MR1 MR3
Correlation of (regression) scores with factors 0.95 0.95 0.95
Multiple R square of scores with factors 0.90 0.90 0.90
Minimum correlation of possible factor scores 0.79 0.80 0.79three factor structure, within bioinspiried dimensions no strong differences in overall answering patterns; 1 item is dysfunctional (negative correlated)
6.2 Descriptives, correlation plot, EFA, CFA for “Ecological Sustainability Scale (PES)”
Applied a self-written function for example to check the reliability and amount of explained variance for the first factor:
regEx <- "^EcologicalDimension"
nameVariable <- "Ecology"
sum(str_detect(string = colnames(dat), pattern = regEx))[1] 4tmp_dat <- na.omit(dat[,str_detect(string = colnames(dat), pattern = regEx)])
tmp <- CFAstats(dataset = tmp_dat, regularExp = regEx, labelLatent = str_remove(string = nameVariable, pattern = "mean_"),
showPlots = TRUE,
computeEFA = TRUE,
computeCFA = TRUE,
computeCFAMplus = FALSE)
descriptive statistics:
Mean SD Median CoeffofVariation Minimum Maximun
EcologicalDimension-1 5.46 1.32 6 0.24 2 7
EcologicalDimension-3 5.84 1.15 6 0.20 2 7
EcologicalDimension-4 5.34 1.31 5 0.25 1 7
EcologicalDimension-2 5.68 1.23 6 0.22 1 7
Lower Quantile Upper Quantile Skewness Kurtosis(-3)
EcologicalDimension-1 2 7 -0.73 -0.10
EcologicalDimension-3 2 7 -0.98 0.73
EcologicalDimension-4 1 7 -0.54 -0.14
EcologicalDimension-2 1 7 -1.04 0.92
KS-Test
EcologicalDimension-1 0
EcologicalDimension-3 0
EcologicalDimension-4 0
EcologicalDimension-2 0
variables under investigation: EcologicalDimension1 EcologicalDimension3 EcologicalDimension4 EcologicalDimension2
Cronbachs Alpha: 0.87 
Parallel analysis suggests that the number of factors = 1 and the number of components = 1
Ecology
Number of components: 1
EFA factor loadings (1 factor solution):
Loadings:
MR1
EcologicalDimension1 0.869
EcologicalDimension3 0.870
EcologicalDimension4 0.710
EcologicalDimension2 0.888
MR1
SS loadings 2.803
Proportion Var 0.701
CFA summary and fit statistics:
lavaan 0.6-19 ended normally after 18 iterations
Estimator ML
Optimization method NLMINB
Number of model parameters 8
Number of observations 298
Model Test User Model:
Standard Scaled
Test Statistic 3.288 3.308
Degrees of freedom 2 2
P-value (Chi-square) 0.193 0.191
Scaling correction factor 0.994
Yuan-Bentler correction (Mplus variant)
Model Test Baseline Model:
Test statistic 601.916 292.934
Degrees of freedom 6 6
P-value 0.000 0.000
Scaling correction factor 2.055
User Model versus Baseline Model:
Comparative Fit Index (CFI) 0.998 0.995
Tucker-Lewis Index (TLI) 0.994 0.986
Robust Comparative Fit Index (CFI) 0.998
Robust Tucker-Lewis Index (TLI) 0.993
Loglikelihood and Information Criteria:
Loglikelihood user model (H0) -1659.391 -1659.391
Scaling correction factor 1.881
for the MLR correction
Loglikelihood unrestricted model (H1) -1657.747 -1657.747
Scaling correction factor 1.703
for the MLR correction
Akaike (AIC) 3334.782 3334.782
Bayesian (BIC) 3364.359 3364.359
Sample-size adjusted Bayesian (SABIC) 3338.988 3338.988
Root Mean Square Error of Approximation:
RMSEA 0.046 0.047
90 Percent confidence interval - lower 0.000 0.000
90 Percent confidence interval - upper 0.133 0.134
P-value H_0: RMSEA <= 0.050 0.411 0.408
P-value H_0: RMSEA >= 0.080 0.337 0.340
Robust RMSEA 0.047
90 Percent confidence interval - lower 0.000
90 Percent confidence interval - upper 0.133
P-value H_0: Robust RMSEA <= 0.050 0.410
P-value H_0: Robust RMSEA >= 0.080 0.337
Standardized Root Mean Square Residual:
SRMR 0.013 0.013
Parameter Estimates:
Standard errors Sandwich
Information bread Observed
Observed information based on Hessian
Latent Variables:
Estimate Std.Err z-value P(>|z|) Std.lv Std.all
Ecology =~
EcologclDmnsn1 1.000 1.090 0.827
EcologclDmnsn3 0.870 0.070 12.465 0.000 0.949 0.824
EcologclDmnsn4 0.794 0.069 11.461 0.000 0.865 0.660
EcologclDmnsn2 0.969 0.067 14.380 0.000 1.056 0.857
Variances:
Estimate Std.Err z-value P(>|z|) Std.lv Std.all
.EcologclDmnsn1 0.550 0.091 6.024 0.000 0.550 0.316
.EcologclDmnsn3 0.425 0.071 5.983 0.000 0.425 0.321
.EcologclDmnsn4 0.971 0.136 7.146 0.000 0.971 0.565
.EcologclDmnsn2 0.403 0.102 3.964 0.000 0.403 0.265
Ecology 1.188 0.140 8.465 0.000 1.000 1.000
CFA first 6 Modification Indices:
lhs op rhs mi epc sepc.lv sepc.all
11 EcologicalDimension1 ~~ EcologicalDimension4 3.276 0.105 0.105 0.144
14 EcologicalDimension3 ~~ EcologicalDimension2 3.276 0.112 0.112 0.270
13 EcologicalDimension3 ~~ EcologicalDimension4 1.277 -0.057 -0.057 -0.089
12 EcologicalDimension1 ~~ EcologicalDimension2 1.277 -0.081 -0.081 -0.171
15 EcologicalDimension4 ~~ EcologicalDimension2 0.442 -0.036 -0.036 -0.058
10 EcologicalDimension1 ~~ EcologicalDimension3 0.442 -0.041 -0.041 -0.085
sepc.nox
11 0.144
14 0.270
13 -0.089
12 -0.171
15 -0.058
10 -0.085des_tab <- tmp$desTable %>%
as.data.frame() %>%
select(Mean, SD, Skewness, `Kurtosis(-3)`, `KS-Test`)
stargazer(
des_tab,
summary = FALSE,
rownames = TRUE,
title = "Descriptive Statistics for Ecological Items",
label = "tab:ecology_desc",
digits = 2,
table.placement = "ht!",
font.size = "small"
)
% Table created by stargazer v.5.2.3 by Marek Hlavac, Social Policy Institute. E-mail: marek.hlavac at gmail.com
% Date and time: Do, Dez 18, 2025 - 11:02:31
\begin{table}[ht!] \centering
\caption{Descriptive Statistics for Ecological Items}
\label{tab:ecology_desc}
\small
\begin{tabular}{@{\extracolsep{5pt}} cccccc}
\\[-1.8ex]\hline
\hline \\[-1.8ex]
& Mean & SD & Skewness & Kurtosis(-3) & KS-Test \\
\hline \\[-1.8ex]
EcologicalDimension-1 & $5.46$ & $1.32$ & $$-$0.73$ & $$-$0.10$ & $0$ \\
EcologicalDimension-3 & $5.84$ & $1.15$ & $$-$0.98$ & $0.73$ & $0$ \\
EcologicalDimension-4 & $5.34$ & $1.31$ & $$-$0.54$ & $$-$0.14$ & $0$ \\
EcologicalDimension-2 & $5.68$ & $1.23$ & $$-$1.04$ & $0.92$ & $0$ \\
\hline \\[-1.8ex]
\end{tabular}
\end{table} omega_results <- psych::omega(tmp_dat, nfactors = 1) # or more if needed
omega_resultsOmega
Call: omegah(m = m, nfactors = nfactors, fm = fm, key = key, flip = flip,
digits = digits, title = title, sl = sl, labels = labels,
plot = plot, n.obs = n.obs, rotate = rotate, Phi = Phi, option = option,
covar = covar)
Alpha: 0.87
G.6: 0.84
Omega Hierarchical: 0.87
Omega H asymptotic: 1
Omega Total 0.87
Schmid Leiman Factor loadings greater than 0.2
g F1* h2 h2 u2 p2 com
EcologicalDimension-1 0.84 0.70 0.70 0.30 1 1
EcologicalDimension-3 0.82 0.67 0.67 0.33 1 1
EcologicalDimension-4 0.66 0.44 0.44 0.56 1 1
EcologicalDimension-2 0.85 0.73 0.73 0.27 1 1
With Sums of squares of:
g F1* h2
2.5 0.0 1.7
general/max 1.53 max/min = Inf
mean percent general = 1 with sd = 0 and cv of 0
Explained Common Variance of the general factor = 1
The degrees of freedom are 2 and the fit is 0.01
The number of observations was 298 with Chi Square = 3.5 with prob < 0.17
The root mean square of the residuals is 0.02
The df corrected root mean square of the residuals is 0.03
RMSEA index = 0.05 and the 90 % confidence intervals are 0 0.136
BIC = -7.9
Compare this with the adequacy of just a general factor and no group factors
The degrees of freedom for just the general factor are 2 and the fit is 0.01
The number of observations was 298 with Chi Square = 3.5 with prob < 0.17
The root mean square of the residuals is 0.02
The df corrected root mean square of the residuals is 0.03
RMSEA index = 0.05 and the 90 % confidence intervals are 0 0.136
BIC = -7.9
Measures of factor score adequacy
g F1*
Correlation of scores with factors 0.94 0
Multiple R square of scores with factors 0.89 0
Minimum correlation of factor score estimates 0.77 -1
Total, General and Subset omega for each subset
g F1*
Omega total for total scores and subscales 0.87 0.87
Omega general for total scores and subscales 0.87 0.87
Omega group for total scores and subscales 0.00 0.00omega_results$omega.tot # Total Omega[1] 0.8724752omega_results$omega.h # Hierarchical OmegaNULLomega_results$omega.g # Group Omega (if multiple factors) total general group
g 0.8724752 0.8724835 0
F1* 0.8724835 0.8724835 06.3 Descriptives, correlation plot, EFA, CFA for “Perceived Bio-Inspiration Scale (PBS)”
6.3.1 Visual Resemblance to Nature (VRtN)
regEx <- "^Bioinspiration-VRtN"
nameVariable <- "VRtN"
sum(str_detect(string = colnames(dat), pattern = regEx))[1] 4tmp_dat <- na.omit(dat[,str_detect(string = colnames(dat), pattern = regEx)])
tmp <- CFAstats(dataset = tmp_dat, regularExp = regEx, labelLatent = str_remove(string = nameVariable, pattern = "mean_"),
showPlots = TRUE,
computeEFA = TRUE,
computeCFA = TRUE,
computeCFAMplus = FALSE)
descriptive statistics:
Mean SD Median CoeffofVariation Minimum Maximun
Bioinspiration-VRtN1 3.87 1.84 4 0.48 1 7
Bioinspiration-VRtN4r 4.97 1.75 5 0.35 1 7
Bioinspiration-VRtN2 5.14 1.48 5 0.29 1 7
Bioinspiration-VRtN3 5.39 1.34 6 0.25 1 7
Lower Quantile Upper Quantile Skewness Kurtosis(-3)
Bioinspiration-VRtN1 1 7 -0.14 -1.13
Bioinspiration-VRtN4r 1 7 -0.69 -0.50
Bioinspiration-VRtN2 1 7 -0.78 0.08
Bioinspiration-VRtN3 1 7 -0.89 0.55
KS-Test
Bioinspiration-VRtN1 0
Bioinspiration-VRtN4r 0
Bioinspiration-VRtN2 0
Bioinspiration-VRtN3 0
variables under investigation: BioinspirationVRtN1 BioinspirationVRtN4r BioinspirationVRtN2 BioinspirationVRtN3
Cronbachs Alpha: 0.77 
Parallel analysis suggests that the number of factors = 2 and the number of components = 1
VRtN
Number of components: 1
EFA factor loadings (1 factor solution):
Loadings:
MR1
BioinspirationVRtN1 0.554
BioinspirationVRtN4r 0.751
BioinspirationVRtN2 0.815
BioinspirationVRtN3 0.771
MR1
SS loadings 2.129
Proportion Var 0.532
CFA summary and fit statistics:
lavaan 0.6-19 ended normally after 24 iterations
Estimator ML
Optimization method NLMINB
Number of model parameters 8
Number of observations 298
Model Test User Model:
Standard Scaled
Test Statistic 22.720 21.166
Degrees of freedom 2 2
P-value (Chi-square) 0.000 0.000
Scaling correction factor 1.073
Yuan-Bentler correction (Mplus variant)
Model Test Baseline Model:
Test statistic 336.565 219.325
Degrees of freedom 6 6
P-value 0.000 0.000
Scaling correction factor 1.535
User Model versus Baseline Model:
Comparative Fit Index (CFI) 0.937 0.910
Tucker-Lewis Index (TLI) 0.812 0.730
Robust Comparative Fit Index (CFI) 0.937
Robust Tucker-Lewis Index (TLI) 0.811
Loglikelihood and Information Criteria:
Loglikelihood user model (H0) -2084.754 -2084.754
Scaling correction factor 1.320
for the MLR correction
Loglikelihood unrestricted model (H1) -2073.394 -2073.394
Scaling correction factor 1.271
for the MLR correction
Akaike (AIC) 4185.508 4185.508
Bayesian (BIC) 4215.085 4215.085
Sample-size adjusted Bayesian (SABIC) 4189.714 4189.714
Root Mean Square Error of Approximation:
RMSEA 0.186 0.179
90 Percent confidence interval - lower 0.122 0.117
90 Percent confidence interval - upper 0.259 0.249
P-value H_0: RMSEA <= 0.050 0.000 0.001
P-value H_0: RMSEA >= 0.080 0.996 0.995
Robust RMSEA 0.186
90 Percent confidence interval - lower 0.120
90 Percent confidence interval - upper 0.261
P-value H_0: Robust RMSEA <= 0.050 0.001
P-value H_0: Robust RMSEA >= 0.080 0.995
Standardized Root Mean Square Residual:
SRMR 0.050 0.050
Parameter Estimates:
Standard errors Sandwich
Information bread Observed
Observed information based on Hessian
Latent Variables:
Estimate Std.Err z-value P(>|z|) Std.lv Std.all
VRtN =~
BionsprtnVRtN1 1.000 0.960 0.523
BinsprtnVRtN4r 1.287 0.212 6.075 0.000 1.235 0.708
BionsprtnVRtN2 1.147 0.129 8.907 0.000 1.101 0.745
BionsprtnVRtN3 1.043 0.173 6.038 0.000 1.001 0.747
Variances:
Estimate Std.Err z-value P(>|z|) Std.lv Std.all
.BionsprtnVRtN1 2.444 0.244 10.033 0.000 2.444 0.726
.BinsprtnVRtN4r 1.518 0.269 5.635 0.000 1.518 0.499
.BionsprtnVRtN2 0.974 0.205 4.754 0.000 0.974 0.445
.BionsprtnVRtN3 0.794 0.125 6.342 0.000 0.794 0.442
VRtN 0.921 0.225 4.100 0.000 1.000 1.000
CFA first 6 Modification Indices:
lhs op rhs mi epc sepc.lv sepc.all
14 BioinspirationVRtN4r ~~ BioinspirationVRtN3 24.273 0.745 0.745 0.679
11 BioinspirationVRtN1 ~~ BioinspirationVRtN2 24.273 0.637 0.637 0.413
12 BioinspirationVRtN1 ~~ BioinspirationVRtN3 6.602 -0.301 -0.301 -0.216
13 BioinspirationVRtN4r ~~ BioinspirationVRtN2 6.602 -0.427 -0.427 -0.351
15 BioinspirationVRtN2 ~~ BioinspirationVRtN3 5.881 -0.337 -0.337 -0.383
10 BioinspirationVRtN1 ~~ BioinspirationVRtN4r 5.881 -0.362 -0.362 -0.188
sepc.nox
14 0.679
11 0.413
12 -0.216
13 -0.351
15 -0.383
10 -0.188des_tab <- tmp$desTable %>%
as.data.frame() %>%
select(Mean, SD, Skewness, `Kurtosis(-3)`, `KS-Test`)
stargazer(
des_tab,
summary = FALSE,
rownames = TRUE,
title = "Descriptive Statistics for Ecological Items",
label = "tab:ecology_desc",
digits = 2,
table.placement = "ht!",
font.size = "small"
)
% Table created by stargazer v.5.2.3 by Marek Hlavac, Social Policy Institute. E-mail: marek.hlavac at gmail.com
% Date and time: Do, Dez 18, 2025 - 11:02:35
\begin{table}[ht!] \centering
\caption{Descriptive Statistics for Ecological Items}
\label{tab:ecology_desc}
\small
\begin{tabular}{@{\extracolsep{5pt}} cccccc}
\\[-1.8ex]\hline
\hline \\[-1.8ex]
& Mean & SD & Skewness & Kurtosis(-3) & KS-Test \\
\hline \\[-1.8ex]
Bioinspiration-VRtN1 & $3.87$ & $1.84$ & $$-$0.14$ & $$-$1.13$ & $0$ \\
Bioinspiration-VRtN4r & $4.97$ & $1.75$ & $$-$0.69$ & $$-$0.50$ & $0$ \\
Bioinspiration-VRtN2 & $5.14$ & $1.48$ & $$-$0.78$ & $0.08$ & $0$ \\
Bioinspiration-VRtN3 & $5.39$ & $1.34$ & $$-$0.89$ & $0.55$ & $0$ \\
\hline \\[-1.8ex]
\end{tabular}
\end{table} omega_results <- psych::omega(tmp_dat, nfactors = 1) # or more if needed
omega_resultsOmega
Call: omegah(m = m, nfactors = nfactors, fm = fm, key = key, flip = flip,
digits = digits, title = title, sl = sl, labels = labels,
plot = plot, n.obs = n.obs, rotate = rotate, Phi = Phi, option = option,
covar = covar)
Alpha: 0.77
G.6: 0.74
Omega Hierarchical: 0.78
Omega H asymptotic: 1
Omega Total 0.78
Schmid Leiman Factor loadings greater than 0.2
g F1* h2 h2 u2 p2 com
Bioinspiration-VRtN1 0.52 0.27 0.27 0.73 1 1
Bioinspiration-VRtN4r 0.69 0.48 0.48 0.52 1 1
Bioinspiration-VRtN2 0.77 0.60 0.60 0.40 1 1
Bioinspiration-VRtN3 0.73 0.54 0.54 0.46 1 1
With Sums of squares of:
g F1* h2
1.89 0.00 0.95
general/max 1.98 max/min = 1.713853e+16
mean percent general = 1 with sd = 0 and cv of 0
Explained Common Variance of the general factor = 1
The degrees of freedom are 2 and the fit is 0.08
The number of observations was 298 with Chi Square = 23.05 with prob < 9.9e-06
The root mean square of the residuals is 0.06
The df corrected root mean square of the residuals is 0.11
RMSEA index = 0.188 and the 90 % confidence intervals are 0.124 0.261
BIC = 11.66
Compare this with the adequacy of just a general factor and no group factors
The degrees of freedom for just the general factor are 2 and the fit is 0.08
The number of observations was 298 with Chi Square = 23.05 with prob < 9.9e-06
The root mean square of the residuals is 0.06
The df corrected root mean square of the residuals is 0.11
RMSEA index = 0.188 and the 90 % confidence intervals are 0.124 0.261
BIC = 11.66
Measures of factor score adequacy
g F1*
Correlation of scores with factors 0.89 0
Multiple R square of scores with factors 0.80 0
Minimum correlation of factor score estimates 0.60 -1
Total, General and Subset omega for each subset
g F1*
Omega total for total scores and subscales 0.78 0.78
Omega general for total scores and subscales 0.78 0.78
Omega group for total scores and subscales 0.00 0.00omega_results$omega.tot # Total Omega[1] 0.7780778omega_results$omega.h # Hierarchical OmegaNULLomega_results$omega.g # Group Omega (if multiple factors) total general group
g 0.7780778 0.7785595 5.834108e-18
F1* 0.7785595 0.7785595 5.834108e-186.3.2 Intentionality & Perceived Inspiration (IPI)
regEx <- "^Bioinspiration-IPI"
nameVariable <- "IPI"
sum(str_detect(string = colnames(dat), pattern = regEx))[1] 4tmp_dat <- na.omit(dat[,str_detect(string = colnames(dat), pattern = regEx)])
tmp <- CFAstats(dataset = tmp_dat, regularExp = regEx, labelLatent = str_remove(string = nameVariable, pattern = "mean_"),
showPlots = TRUE,
computeEFA = TRUE,
computeCFA = TRUE,
computeCFAMplus = FALSE)
descriptive statistics:
Mean SD Median CoeffofVariation Minimum Maximun
Bioinspiration-IPI1 5.95 1.15 6 0.19 1 7
Bioinspiration-IPI2r 5.31 1.57 6 0.29 1 7
Bioinspiration-IPI3 5.91 1.14 6 0.19 2 7
Bioinspiration-IPI4 5.80 1.19 6 0.20 1 7
Lower Quantile Upper Quantile Skewness Kurtosis(-3)
Bioinspiration-IPI1 1 7 -1.10 1.04
Bioinspiration-IPI2r 1 7 -1.00 0.45
Bioinspiration-IPI3 2 7 -1.14 1.24
Bioinspiration-IPI4 1 7 -1.03 1.04
KS-Test
Bioinspiration-IPI1 0
Bioinspiration-IPI2r 0
Bioinspiration-IPI3 0
Bioinspiration-IPI4 0
variables under investigation: BioinspirationIPI1 BioinspirationIPI2r BioinspirationIPI3 BioinspirationIPI4
Cronbachs Alpha: 0.82 
Parallel analysis suggests that the number of factors = 1 and the number of components = 1
IPI
Number of components: 1
EFA factor loadings (1 factor solution):
Loadings:
MR1
BioinspirationIPI1 0.920
BioinspirationIPI2r 0.576
BioinspirationIPI3 0.864
BioinspirationIPI4 0.847
MR1
SS loadings 2.642
Proportion Var 0.661
CFA summary and fit statistics:
lavaan 0.6-19 ended normally after 19 iterations
Estimator ML
Optimization method NLMINB
Number of model parameters 8
Number of observations 298
Model Test User Model:
Standard Scaled
Test Statistic 1.214 1.399
Degrees of freedom 2 2
P-value (Chi-square) 0.545 0.497
Scaling correction factor 0.867
Yuan-Bentler correction (Mplus variant)
Model Test Baseline Model:
Test statistic 497.197 215.036
Degrees of freedom 6 6
P-value 0.000 0.000
Scaling correction factor 2.312
User Model versus Baseline Model:
Comparative Fit Index (CFI) 1.000 1.000
Tucker-Lewis Index (TLI) 1.005 1.009
Robust Comparative Fit Index (CFI) 1.000
Robust Tucker-Lewis Index (TLI) 1.003
Loglikelihood and Information Criteria:
Loglikelihood user model (H0) -1707.055 -1707.055
Scaling correction factor 2.253
for the MLR correction
Loglikelihood unrestricted model (H1) -1706.448 -1706.448
Scaling correction factor 1.976
for the MLR correction
Akaike (AIC) 3430.109 3430.109
Bayesian (BIC) 3459.686 3459.686
Sample-size adjusted Bayesian (SABIC) 3434.315 3434.315
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.099 0.111
P-value H_0: RMSEA <= 0.050 0.737 0.672
P-value H_0: RMSEA >= 0.080 0.110 0.156
Robust RMSEA 0.000
90 Percent confidence interval - lower 0.000
90 Percent confidence interval - upper 0.096
P-value H_0: Robust RMSEA <= 0.050 0.725
P-value H_0: Robust RMSEA >= 0.080 0.104
Standardized Root Mean Square Residual:
SRMR 0.009 0.009
Parameter Estimates:
Standard errors Sandwich
Information bread Observed
Observed information based on Hessian
Latent Variables:
Estimate Std.Err z-value P(>|z|) Std.lv Std.all
IPI =~
BioinsprtnIPI1 1.000 1.031 0.895
BionsprtnIPI2r 0.672 0.099 6.806 0.000 0.692 0.443
BioinsprtnIPI3 0.889 0.069 12.803 0.000 0.916 0.805
BioinsprtnIPI4 0.899 0.074 12.074 0.000 0.926 0.783
Variances:
Estimate Std.Err z-value P(>|z|) Std.lv Std.all
.BioinsprtnIPI1 0.264 0.059 4.490 0.000 0.264 0.199
.BionsprtnIPI2r 1.962 0.279 7.023 0.000 1.962 0.804
.BioinsprtnIPI3 0.455 0.085 5.350 0.000 0.455 0.351
.BioinsprtnIPI4 0.543 0.133 4.068 0.000 0.543 0.387
IPI 1.062 0.136 7.790 0.000 1.000 1.000
CFA first 6 Modification Indices:
lhs op rhs mi epc sepc.lv sepc.all
10 BioinspirationIPI1 ~~ BioinspirationIPI2r 0.981 -0.066 -0.066 -0.092
15 BioinspirationIPI3 ~~ BioinspirationIPI4 0.981 -0.079 -0.079 -0.159
12 BioinspirationIPI1 ~~ BioinspirationIPI4 0.940 0.097 0.097 0.257
13 BioinspirationIPI2r ~~ BioinspirationIPI3 0.940 0.065 0.065 0.068
14 BioinspirationIPI2r ~~ BioinspirationIPI4 0.020 0.010 0.010 0.010
11 BioinspirationIPI1 ~~ BioinspirationIPI3 0.020 0.015 0.015 0.043
sepc.nox
10 -0.092
15 -0.159
12 0.257
13 0.068
14 0.010
11 0.043des_tab <- tmp$desTable %>%
as.data.frame() %>%
select(Mean, SD, Skewness, `Kurtosis(-3)`, `KS-Test`)
stargazer(
des_tab,
summary = FALSE,
rownames = TRUE,
title = "Descriptive Statistics for Ecological Items",
label = "tab:ecology_desc",
digits = 2,
table.placement = "ht!",
font.size = "small"
)
% Table created by stargazer v.5.2.3 by Marek Hlavac, Social Policy Institute. E-mail: marek.hlavac at gmail.com
% Date and time: Do, Dez 18, 2025 - 11:02:40
\begin{table}[ht!] \centering
\caption{Descriptive Statistics for Ecological Items}
\label{tab:ecology_desc}
\small
\begin{tabular}{@{\extracolsep{5pt}} cccccc}
\\[-1.8ex]\hline
\hline \\[-1.8ex]
& Mean & SD & Skewness & Kurtosis(-3) & KS-Test \\
\hline \\[-1.8ex]
Bioinspiration-IPI1 & $5.95$ & $1.15$ & $$-$1.10$ & $1.04$ & $0$ \\
Bioinspiration-IPI2r & $5.31$ & $1.57$ & $$-$1$ & $0.45$ & $0$ \\
Bioinspiration-IPI3 & $5.91$ & $1.14$ & $$-$1.14$ & $1.24$ & $0$ \\
Bioinspiration-IPI4 & $5.80$ & $1.19$ & $$-$1.03$ & $1.04$ & $0$ \\
\hline \\[-1.8ex]
\end{tabular}
\end{table} omega_results <- psych::omega(tmp_dat, nfactors = 1) # or more if needed
omega_resultsOmega
Call: omegah(m = m, nfactors = nfactors, fm = fm, key = key, flip = flip,
digits = digits, title = title, sl = sl, labels = labels,
plot = plot, n.obs = n.obs, rotate = rotate, Phi = Phi, option = option,
covar = covar)
Alpha: 0.82
G.6: 0.8
Omega Hierarchical: 0.83
Omega H asymptotic: 1
Omega Total 0.83
Schmid Leiman Factor loadings greater than 0.2
g F1* h2 h2 u2 p2 com
Bioinspiration-IPI1 0.89 0.79 0.79 0.21 1 1
Bioinspiration-IPI2r 0.45 0.20 0.20 0.80 1 1
Bioinspiration-IPI3 0.81 0.66 0.66 0.34 1 1
Bioinspiration-IPI4 0.78 0.61 0.61 0.39 1 1
With Sums of squares of:
g F1* h2
2.3 0.0 1.5
general/max 1.54 max/min = Inf
mean percent general = 1 with sd = 0 and cv of 0
Explained Common Variance of the general factor = 1
The degrees of freedom are 2 and the fit is 0
The number of observations was 298 with Chi Square = 1.31 with prob < 0.52
The root mean square of the residuals is 0.01
The df corrected root mean square of the residuals is 0.02
RMSEA index = 0 and the 90 % confidence intervals are 0 0.102
BIC = -10.08
Compare this with the adequacy of just a general factor and no group factors
The degrees of freedom for just the general factor are 2 and the fit is 0
The number of observations was 298 with Chi Square = 1.31 with prob < 0.52
The root mean square of the residuals is 0.01
The df corrected root mean square of the residuals is 0.02
RMSEA index = 0 and the 90 % confidence intervals are 0 0.102
BIC = -10.08
Measures of factor score adequacy
g F1*
Correlation of scores with factors 0.94 0
Multiple R square of scores with factors 0.88 0
Minimum correlation of factor score estimates 0.76 -1
Total, General and Subset omega for each subset
g F1*
Omega total for total scores and subscales 0.83 0.83
Omega general for total scores and subscales 0.83 0.83
Omega group for total scores and subscales 0.00 0.00omega_results$omega.tot # Total Omega[1] 0.8314019omega_results$omega.h # Hierarchical OmegaNULLomega_results$omega.g # Group Omega (if multiple factors) total general group
g 0.8314019 0.8312676 0
F1* 0.8312676 0.8312676 06.3.3 Perceived Naturalness (PN)
regEx <- "^Bioinspiration-PN"
nameVariable <- "PN"
sum(str_detect(string = colnames(dat), pattern = regEx))[1] 4tmp_dat <- na.omit(dat[,str_detect(string = colnames(dat), pattern = regEx)])
tmp <- CFAstats(dataset = tmp_dat, regularExp = regEx, labelLatent = str_remove(string = nameVariable, pattern = "mean_"),
showPlots = TRUE,
computeEFA = TRUE,
computeCFA = TRUE,
computeCFAMplus = FALSE)
descriptive statistics:
Mean SD Median CoeffofVariation Minimum Maximun
Bioinspiration-PN4 3.96 1.72 4 0.43 1 7
Bioinspiration-PN2r 4.56 1.68 5 0.37 1 7
Bioinspiration-PN3 3.90 1.74 4 0.45 1 7
Bioinspiration-PN1 4.13 1.74 4 0.42 1 7
Lower Quantile Upper Quantile Skewness Kurtosis(-3) KS-Test
Bioinspiration-PN4 1 7 -0.13 -1.08 0
Bioinspiration-PN2r 1 7 -0.20 -1.05 0
Bioinspiration-PN3 1 7 -0.03 -1.04 0
Bioinspiration-PN1 1 7 -0.22 -1.02 0
variables under investigation: BioinspirationPN4 BioinspirationPN2r BioinspirationPN3 BioinspirationPN1 Some items ( Bioinspiration-PN2r ) were negatively correlated with the first principal component and
probably should be reversed.
To do this, run the function again with the 'check.keys=TRUE' optionCronbachs Alpha: 0.43 
Parallel analysis suggests that the number of factors = 2 and the number of components = 1
PN
Number of components: 1
EFA factor loadings (1 factor solution):
Loadings:
MR1
BioinspirationPN4 0.732
BioinspirationPN2r -0.392
BioinspirationPN3 0.811
BioinspirationPN1 0.850
MR1
SS loadings 2.069
Proportion Var 0.517
CFA summary and fit statistics:
lavaan 0.6-19 ended normally after 28 iterations
Estimator ML
Optimization method NLMINB
Number of model parameters 8
Number of observations 298
Model Test User Model:
Standard Scaled
Test Statistic 15.797 13.626
Degrees of freedom 2 2
P-value (Chi-square) 0.000 0.001
Scaling correction factor 1.159
Yuan-Bentler correction (Mplus variant)
Model Test Baseline Model:
Test statistic 375.955 245.919
Degrees of freedom 6 6
P-value 0.000 0.000
Scaling correction factor 1.529
User Model versus Baseline Model:
Comparative Fit Index (CFI) 0.963 0.952
Tucker-Lewis Index (TLI) 0.888 0.855
Robust Comparative Fit Index (CFI) 0.963
Robust Tucker-Lewis Index (TLI) 0.890
Loglikelihood and Information Criteria:
Loglikelihood user model (H0) -2155.339 -2155.339
Scaling correction factor 1.095
for the MLR correction
Loglikelihood unrestricted model (H1) -2147.440 -2147.440
Scaling correction factor 1.108
for the MLR correction
Akaike (AIC) 4326.678 4326.678
Bayesian (BIC) 4356.255 4356.255
Sample-size adjusted Bayesian (SABIC) 4330.884 4330.884
Root Mean Square Error of Approximation:
RMSEA 0.152 0.140
90 Percent confidence interval - lower 0.088 0.080
90 Percent confidence interval - upper 0.226 0.208
P-value H_0: RMSEA <= 0.050 0.006 0.009
P-value H_0: RMSEA >= 0.080 0.967 0.950
Robust RMSEA 0.150
90 Percent confidence interval - lower 0.082
90 Percent confidence interval - upper 0.230
P-value H_0: Robust RMSEA <= 0.050 0.010
P-value H_0: Robust RMSEA >= 0.080 0.954
Standardized Root Mean Square Residual:
SRMR 0.049 0.049
Parameter Estimates:
Standard errors Sandwich
Information bread Observed
Observed information based on Hessian
Latent Variables:
Estimate Std.Err z-value P(>|z|) Std.lv Std.all
PN =~
BioinspirtnPN4 1.000 1.124 0.654
BioinsprtnPN2r -0.484 0.098 -4.948 0.000 -0.544 -0.325
BioinspirtnPN3 1.264 0.126 10.020 0.000 1.421 0.820
BioinspirtnPN1 1.324 0.130 10.196 0.000 1.488 0.856
Variances:
Estimate Std.Err z-value P(>|z|) Std.lv Std.all
.BioinspirtnPN4 1.692 0.198 8.558 0.000 1.692 0.572
.BioinsprtnPN2r 2.514 0.173 14.563 0.000 2.514 0.895
.BioinspirtnPN3 0.984 0.177 5.556 0.000 0.984 0.328
.BioinspirtnPN1 0.808 0.183 4.405 0.000 0.808 0.267
PN 1.263 0.221 5.718 0.000 1.000 1.000
CFA first 6 Modification Indices:
lhs op rhs mi epc sepc.lv sepc.all
15 BioinspirationPN3 ~~ BioinspirationPN1 15.365 1.771 1.771 1.986
10 BioinspirationPN4 ~~ BioinspirationPN2r 15.365 -0.512 -0.512 -0.249
11 BioinspirationPN4 ~~ BioinspirationPN3 4.338 -0.512 -0.512 -0.397
14 BioinspirationPN2r ~~ BioinspirationPN1 4.338 0.259 0.259 0.182
12 BioinspirationPN4 ~~ BioinspirationPN1 0.576 -0.201 -0.201 -0.172
13 BioinspirationPN2r ~~ BioinspirationPN3 0.576 0.093 0.093 0.059
sepc.nox
15 1.986
10 -0.249
11 -0.397
14 0.182
12 -0.172
13 0.0596.4 Delete Items
dat$`Bioinspiration-PN2r` <- NULL6.4.1 run again: Perceived Naturalness (PN)
regEx <- "^Bioinspiration-PN"
nameVariable <- "PN"
sum(str_detect(string = colnames(dat), pattern = regEx))[1] 3tmp_dat <- na.omit(dat[,str_detect(string = colnames(dat), pattern = regEx)])
tmp <- CFAstats(dataset = tmp_dat, regularExp = regEx, labelLatent = str_remove(string = nameVariable, pattern = "mean_"),
showPlots = TRUE,
computeEFA = TRUE,
computeCFA = TRUE,
computeCFAMplus = FALSE)
descriptive statistics:
Mean SD Median CoeffofVariation Minimum Maximun
Bioinspiration-PN4 3.96 1.72 4 0.43 1 7
Bioinspiration-PN3 3.90 1.74 4 0.45 1 7
Bioinspiration-PN1 4.13 1.74 4 0.42 1 7
Lower Quantile Upper Quantile Skewness Kurtosis(-3) KS-Test
Bioinspiration-PN4 1 7 -0.13 -1.08 0
Bioinspiration-PN3 1 7 -0.03 -1.04 0
Bioinspiration-PN1 1 7 -0.22 -1.02 0
variables under investigation: BioinspirationPN4 BioinspirationPN3 BioinspirationPN1
Cronbachs Alpha: 0.82 
Parallel analysis suggests that the number of factors = 1 and the number of components = 1
PN
Number of components: 1
EFA factor loadings (1 factor solution):
Loadings:
MR1
BioinspirationPN4 0.674
BioinspirationPN3 0.828
BioinspirationPN1 0.892
MR1
SS loadings 1.935
Proportion Var 0.645
CFA summary and fit statistics:
lavaan 0.6-19 ended normally after 24 iterations
Estimator ML
Optimization method NLMINB
Number of model parameters 6
Number of observations 298
Model Test User Model:
Standard Scaled
Test Statistic 0.000 0.000
Degrees of freedom 0 0
Model Test Baseline Model:
Test statistic 332.640 182.283
Degrees of freedom 3 3
P-value 0.000 0.000
Scaling correction factor 1.825
User Model versus Baseline Model:
Comparative Fit Index (CFI) 1.000 1.000
Tucker-Lewis Index (TLI) 1.000 1.000
Robust Comparative Fit Index (CFI) NA
Robust Tucker-Lewis Index (TLI) NA
Loglikelihood and Information Criteria:
Loglikelihood user model (H0) -1592.304 -1592.304
Loglikelihood unrestricted model (H1) -1592.304 -1592.304
Akaike (AIC) 3196.608 3196.608
Bayesian (BIC) 3218.790 3218.790
Sample-size adjusted Bayesian (SABIC) 3199.762 3199.762
Root Mean Square Error of Approximation:
RMSEA 0.000 NA
90 Percent confidence interval - lower 0.000 NA
90 Percent confidence interval - upper 0.000 NA
P-value H_0: RMSEA <= 0.050 NA NA
P-value H_0: RMSEA >= 0.080 NA NA
Robust RMSEA 0.000
90 Percent confidence interval - lower 0.000
90 Percent confidence interval - upper 0.000
P-value H_0: Robust RMSEA <= 0.050 NA
P-value H_0: Robust RMSEA >= 0.080 NA
Standardized Root Mean Square Residual:
SRMR 0.000 0.000
Parameter Estimates:
Standard errors Sandwich
Information bread Observed
Observed information based on Hessian
Latent Variables:
Estimate Std.Err z-value P(>|z|) Std.lv Std.all
PN =~
BioinspirtnPN4 1.000 1.097 0.638
BioinspirtnPN3 1.288 0.125 10.303 0.000 1.413 0.815
BioinspirtnPN1 1.379 0.141 9.784 0.000 1.513 0.870
Variances:
Estimate Std.Err z-value P(>|z|) Std.lv Std.all
.BioinspirtnPN4 1.752 0.196 8.952 0.000 1.752 0.593
.BioinspirtnPN3 1.006 0.186 5.413 0.000 1.006 0.335
.BioinspirtnPN1 0.734 0.211 3.475 0.001 0.734 0.243
PN 1.203 0.215 5.596 0.000 1.000 1.000
CFA first 6 Modification Indices:
[1] lhs op rhs mi epc sepc.lv sepc.all sepc.nox
<0 Zeilen> (oder row.names mit Länge 0)des_tab <- tmp$desTable %>%
as.data.frame() %>%
select(Mean, SD, Skewness, `Kurtosis(-3)`, `KS-Test`)
stargazer(
des_tab,
summary = FALSE,
rownames = TRUE,
title = "Descriptive Statistics for Ecological Items",
label = "tab:ecology_desc",
digits = 2,
table.placement = "ht!",
font.size = "small"
)
% Table created by stargazer v.5.2.3 by Marek Hlavac, Social Policy Institute. E-mail: marek.hlavac at gmail.com
% Date and time: Do, Dez 18, 2025 - 11:02:47
\begin{table}[ht!] \centering
\caption{Descriptive Statistics for Ecological Items}
\label{tab:ecology_desc}
\small
\begin{tabular}{@{\extracolsep{5pt}} cccccc}
\\[-1.8ex]\hline
\hline \\[-1.8ex]
& Mean & SD & Skewness & Kurtosis(-3) & KS-Test \\
\hline \\[-1.8ex]
Bioinspiration-PN4 & $3.96$ & $1.72$ & $$-$0.13$ & $$-$1.08$ & $0$ \\
Bioinspiration-PN3 & $3.90$ & $1.74$ & $$-$0.03$ & $$-$1.04$ & $0$ \\
Bioinspiration-PN1 & $4.13$ & $1.74$ & $$-$0.22$ & $$-$1.02$ & $0$ \\
\hline \\[-1.8ex]
\end{tabular}
\end{table} omega_results <- psych::omega(tmp_dat, nfactors = 1) # or more if needed
omega_resultsOmega
Call: omegah(m = m, nfactors = nfactors, fm = fm, key = key, flip = flip,
digits = digits, title = title, sl = sl, labels = labels,
plot = plot, n.obs = n.obs, rotate = rotate, Phi = Phi, option = option,
covar = covar)
Alpha: 0.82
G.6: 0.76
Omega Hierarchical: 0.82
Omega H asymptotic: 1
Omega Total 0.82
Schmid Leiman Factor loadings greater than 0.2
g F1* h2 h2 u2 p2 com
Bioinspiration-PN4 0.64 0.41 0.41 0.59 1 1
Bioinspiration-PN3 0.82 0.66 0.66 0.34 1 1
Bioinspiration-PN1 0.87 0.76 0.76 0.24 1 1
With Sums of squares of:
g F1* h2
1.8 0.0 1.2
general/max 1.55 max/min = Inf
mean percent general = 1 with sd = 0 and cv of 0
Explained Common Variance of the general factor = 1
The degrees of freedom are 0 and the fit is 0
The number of observations was 298 with Chi Square = 0 with prob < NA
The root mean square of the residuals is 0
The df corrected root mean square of the residuals is NA
Compare this with the adequacy of just a general factor and no group factors
The degrees of freedom for just the general factor are 0 and the fit is 0
The number of observations was 298 with Chi Square = 0 with prob < NA
The root mean square of the residuals is 0
The df corrected root mean square of the residuals is NA
Measures of factor score adequacy
g F1*
Correlation of scores with factors 0.92 0
Multiple R square of scores with factors 0.85 0
Minimum correlation of factor score estimates 0.71 -1
Total, General and Subset omega for each subset
g F1*
Omega total for total scores and subscales 0.82 0.82
Omega general for total scores and subscales 0.82 0.82
Omega group for total scores and subscales 0.00 0.00omega_results$omega.tot # Total Omega[1] 0.8218047omega_results$omega.h # Hierarchical OmegaNULLomega_results$omega.g # Group Omega (if multiple factors) total general group
g 0.8218047 0.8218035 0
F1* 0.8218035 0.8218035 06.4.2 run again: EFA for “Perceived Bio-Inspiration Scale (PBS)”
#### Overall EFA
regExOverall <- "^Bioinspiration"
psych::cor.plot(r = cor(dat[, str_detect(string = colnames(dat),
pattern = regExOverall)]
, use = "pairwise.complete.obs"),
upper = FALSE, xlas = 2, main = "Overall")
#> parallel analysis
tmp_parallelAnalysis <- dimensionalityTest(label = "Overall",
regEx = regExOverall, dataset = dat)Warning in fa.stats(r = r, f = f, phi = phi, n.obs = n.obs, np.obs = np.obs, :
The estimated weights for the factor scores are probably incorrect. Try a
different factor score estimation method.
Parallel analysis suggests that the number of factors = 2 and the number of components = 2
Overall
Number of components: 2 #> EFA (# of factors=5)
tmp_EFA <- explorativeFactorAnalysis(label = "Overall",
regEx = regExOverall,
dataset = dat, nfac = tmp_parallelAnalysis$nfact)Warning in fa.stats(r = r, f = f, phi = phi, n.obs = n.obs, np.obs = np.obs, :
The estimated weights for the factor scores are probably incorrect. Try a
different factor score estimation method.tmp_EFA[[1]]Factor Analysis using method = minres
Call: fa(r = tmp_dat, nfactors = nfac, rotate = "promax", cor = "cor")
Standardized loadings (pattern matrix) based upon correlation matrix
MR1 MR2 h2 u2 com
Bioinspiration-VRtN1 -0.09 0.85 0.68 0.32 1.0
Bioinspiration-PN4 -0.02 0.67 0.44 0.56 1.0
Bioinspiration-VRtN4r 0.56 0.23 0.46 0.54 1.3
Bioinspiration-IPI1 0.89 -0.07 0.75 0.25 1.0
Bioinspiration-VRtN2 0.41 0.47 0.55 0.45 2.0
Bioinspiration-IPI2r 0.57 -0.27 0.28 0.72 1.4
Bioinspiration-PN3 -0.09 0.84 0.66 0.34 1.0
Bioinspiration-IPI3 0.79 0.01 0.63 0.37 1.0
Bioinspiration-IPI4 0.77 0.02 0.61 0.39 1.0
Bioinspiration-VRtN3 0.63 0.23 0.55 0.45 1.3
Bioinspiration-PN1 0.00 0.84 0.70 0.30 1.0
MR1 MR2
SS loadings 3.27 3.04
Proportion Var 0.30 0.28
Cumulative Var 0.30 0.57
Proportion Explained 0.52 0.48
Cumulative Proportion 0.52 1.00
With factor correlations of
MR1 MR2
MR1 1.00 0.39
MR2 0.39 1.00
Mean item complexity = 1.2
Test of the hypothesis that 2 factors are sufficient.
df null model = 55 with the objective function = 5.75 with Chi Square = 1682.13
df of the model are 34 and the objective function was 0.25
The root mean square of the residuals (RMSR) is 0.03
The df corrected root mean square of the residuals is 0.04
The harmonic n.obs is 298 with the empirical chi square 30.34 with prob < 0.65
The total n.obs was 298 with Likelihood Chi Square = 73.68 with prob < 9.4e-05
Tucker Lewis Index of factoring reliability = 0.96
RMSEA index = 0.062 and the 90 % confidence intervals are 0.043 0.082
BIC = -120.02
Fit based upon off diagonal values = 0.99
Measures of factor score adequacy
MR1 MR2
Correlation of (regression) scores with factors 0.95 0.95
Multiple R square of scores with factors 0.90 0.90
Minimum correlation of possible factor scores 0.79 0.79two factor structure, within bioinspiried dimensions no strong differences in overall answering patterns
6.5 evaluation videos
6.5.1 Subjective Outcome Evaluation Scale
regEx <- "^evalInf"
nameVariable <- "subOutEval"
sum(str_detect(string = colnames(dat), pattern = regEx))[1] 10tmp_dat <- na.omit(dat[,str_detect(string = colnames(dat), pattern = regEx)])
tmp <- CFAstats(dataset = tmp_dat, regularExp = regEx, labelLatent = str_remove(string = nameVariable, pattern = "mean_"),
showPlots = TRUE,
computeEFA = TRUE,
computeCFA = TRUE,
computeCFAMplus = FALSE)
descriptive statistics:
Mean SD Median CoeffofVariation Minimum Maximun Lower Quantile
evalInf-6 4.94 0.99 5 0.20 1 6 1
evalInf-5 4.73 0.95 5 0.20 1 6 1
evalInf-8 4.82 0.98 5 0.20 1 6 1
evalInf-2 5.35 0.76 5 0.14 1 6 1
evalInf-3 4.86 1.12 5 0.23 1 6 1
evalInf-4 4.74 1.21 5 0.25 1 6 1
evalInf-10 4.83 1.09 5 0.23 1 6 1
evalInf-7 4.44 1.28 5 0.29 1 6 1
evalInf-1 4.62 1.16 5 0.25 1 6 1
evalInf-9 4.49 1.18 5 0.26 1 6 1
Upper Quantile Skewness Kurtosis(-3) KS-Test
evalInf-6 6 -1.28 2.62 0
evalInf-5 6 -0.82 1.23 0
evalInf-8 6 -0.93 1.30 0
evalInf-2 6 -1.27 2.92 0
evalInf-3 6 -1.15 1.36 0
evalInf-4 6 -1.10 1.05 0
evalInf-10 6 -1.16 1.44 0
evalInf-7 6 -0.77 0.05 0
evalInf-1 6 -0.90 0.50 0
evalInf-9 6 -0.77 0.21 0
variables under investigation: evalInf6 evalInf5 evalInf8 evalInf2 evalInf3 evalInf4 evalInf10 evalInf7 evalInf1 evalInf9
Cronbachs Alpha: 0.94 
Parallel analysis suggests that the number of factors = 1 and the number of components = 1
subOutEval
Number of components: 1
EFA factor loadings (1 factor solution):
Loadings:
MR1
evalInf6 0.854
evalInf5 0.842
evalInf8 0.831
evalInf2 0.725
evalInf3 0.788
evalInf4 0.884
evalInf10 0.921
evalInf7 0.842
evalInf1 0.843
evalInf9 0.819
MR1
SS loadings 6.997
Proportion Var 0.700
CFA summary and fit statistics:
lavaan 0.6-19 ended normally after 26 iterations
Estimator ML
Optimization method NLMINB
Number of model parameters 20
Number of observations 298
Model Test User Model:
Standard Scaled
Test Statistic 236.761 172.898
Degrees of freedom 35 35
P-value (Chi-square) 0.000 0.000
Scaling correction factor 1.369
Yuan-Bentler correction (Mplus variant)
Model Test Baseline Model:
Test statistic 2420.973 1646.477
Degrees of freedom 45 45
P-value 0.000 0.000
Scaling correction factor 1.470
User Model versus Baseline Model:
Comparative Fit Index (CFI) 0.915 0.914
Tucker-Lewis Index (TLI) 0.891 0.889
Robust Comparative Fit Index (CFI) 0.920
Robust Tucker-Lewis Index (TLI) 0.897
Loglikelihood and Information Criteria:
Loglikelihood user model (H0) -3310.953 -3310.953
Scaling correction factor 1.729
for the MLR correction
Loglikelihood unrestricted model (H1) -3192.572 -3192.572
Scaling correction factor 1.500
for the MLR correction
Akaike (AIC) 6661.906 6661.906
Bayesian (BIC) 6735.848 6735.848
Sample-size adjusted Bayesian (SABIC) 6672.421 6672.421
Root Mean Square Error of Approximation:
RMSEA 0.139 0.115
90 Percent confidence interval - lower 0.123 0.101
90 Percent confidence interval - upper 0.156 0.130
P-value H_0: RMSEA <= 0.050 0.000 0.000
P-value H_0: RMSEA >= 0.080 1.000 1.000
Robust RMSEA 0.135
90 Percent confidence interval - lower 0.115
90 Percent confidence interval - upper 0.155
P-value H_0: Robust RMSEA <= 0.050 0.000
P-value H_0: Robust RMSEA >= 0.080 1.000
Standardized Root Mean Square Residual:
SRMR 0.043 0.043
Parameter Estimates:
Standard errors Sandwich
Information bread Observed
Observed information based on Hessian
Latent Variables:
Estimate Std.Err z-value P(>|z|) Std.lv Std.all
subOutEval =~
evalInf6 1.000 0.781 0.789
evalInf5 0.968 0.069 14.097 0.000 0.756 0.794
evalInf8 0.969 0.082 11.864 0.000 0.757 0.770
evalInf2 0.585 0.050 11.613 0.000 0.457 0.602
evalInf3 1.074 0.118 9.099 0.000 0.839 0.747
evalInf4 1.331 0.108 12.282 0.000 1.040 0.864
evalInf10 1.235 0.104 11.919 0.000 0.964 0.889
evalInf7 1.325 0.093 14.183 0.000 1.035 0.811
evalInf1 1.233 0.109 11.286 0.000 0.963 0.833
evalInf9 1.211 0.092 13.146 0.000 0.946 0.800
Variances:
Estimate Std.Err z-value P(>|z|) Std.lv Std.all
.evalInf6 0.370 0.042 8.761 0.000 0.370 0.378
.evalInf5 0.336 0.031 10.757 0.000 0.336 0.370
.evalInf8 0.393 0.045 8.778 0.000 0.393 0.407
.evalInf2 0.367 0.068 5.380 0.000 0.367 0.638
.evalInf3 0.556 0.067 8.337 0.000 0.556 0.441
.evalInf4 0.367 0.047 7.886 0.000 0.367 0.254
.evalInf10 0.248 0.033 7.563 0.000 0.248 0.210
.evalInf7 0.558 0.068 8.197 0.000 0.558 0.343
.evalInf1 0.410 0.043 9.611 0.000 0.410 0.307
.evalInf9 0.503 0.074 6.790 0.000 0.503 0.360
subOutEval 0.610 0.107 5.711 0.000 1.000 1.000
CFA first 6 Modification Indices:
lhs op rhs mi epc sepc.lv sepc.all sepc.nox
62 evalInf10 ~~ evalInf1 57.841 0.176 0.176 0.551 0.551
53 evalInf3 ~~ evalInf10 30.424 0.141 0.141 0.379 0.379
61 evalInf10 ~~ evalInf7 27.677 -0.139 -0.139 -0.374 -0.374
58 evalInf4 ~~ evalInf7 21.550 0.144 0.144 0.318 0.318
65 evalInf7 ~~ evalInf9 16.289 0.140 0.140 0.264 0.264
54 evalInf3 ~~ evalInf7 15.866 -0.142 -0.142 -0.255 -0.255des_tab <- tmp$desTable %>%
as.data.frame() %>%
select(Mean, SD, Skewness, `Kurtosis(-3)`, `KS-Test`)
stargazer(
des_tab,
summary = FALSE,
rownames = TRUE,
title = "Descriptive Statistics for Subjective Outcome Evaluation Items",
label = "tab:ecology_desc",
digits = 2,
table.placement = "ht!",
font.size = "small"
)
% Table created by stargazer v.5.2.3 by Marek Hlavac, Social Policy Institute. E-mail: marek.hlavac at gmail.com
% Date and time: Do, Dez 18, 2025 - 11:03:06
\begin{table}[ht!] \centering
\caption{Descriptive Statistics for Subjective Outcome Evaluation Items}
\label{tab:ecology_desc}
\small
\begin{tabular}{@{\extracolsep{5pt}} cccccc}
\\[-1.8ex]\hline
\hline \\[-1.8ex]
& Mean & SD & Skewness & Kurtosis(-3) & KS-Test \\
\hline \\[-1.8ex]
evalInf-6 & $4.94$ & $0.99$ & $$-$1.28$ & $2.62$ & $0$ \\
evalInf-5 & $4.73$ & $0.95$ & $$-$0.82$ & $1.23$ & $0$ \\
evalInf-8 & $4.82$ & $0.98$ & $$-$0.93$ & $1.30$ & $0$ \\
evalInf-2 & $5.35$ & $0.76$ & $$-$1.27$ & $2.92$ & $0$ \\
evalInf-3 & $4.86$ & $1.12$ & $$-$1.15$ & $1.36$ & $0$ \\
evalInf-4 & $4.74$ & $1.21$ & $$-$1.10$ & $1.05$ & $0$ \\
evalInf-10 & $4.83$ & $1.09$ & $$-$1.16$ & $1.44$ & $0$ \\
evalInf-7 & $4.44$ & $1.28$ & $$-$0.77$ & $0.05$ & $0$ \\
evalInf-1 & $4.62$ & $1.16$ & $$-$0.90$ & $0.50$ & $0$ \\
evalInf-9 & $4.49$ & $1.18$ & $$-$0.77$ & $0.21$ & $0$ \\
\hline \\[-1.8ex]
\end{tabular}
\end{table} omega_results <- psych::omega(tmp_dat, nfactors = 1) # or more if needed
omega_resultsOmega
Call: omegah(m = m, nfactors = nfactors, fm = fm, key = key, flip = flip,
digits = digits, title = title, sl = sl, labels = labels,
plot = plot, n.obs = n.obs, rotate = rotate, Phi = Phi, option = option,
covar = covar)
Alpha: 0.94
G.6: 0.95
Omega Hierarchical: 0.94
Omega H asymptotic: 1
Omega Total 0.94
Schmid Leiman Factor loadings greater than 0.2
g F1* h2 h2 u2 p2 com
evalInf-6 0.80 0.64 0.64 0.36 1 1
evalInf-5 0.80 0.65 0.65 0.35 1 1
evalInf-8 0.78 0.61 0.61 0.39 1 1
evalInf-2 0.61 0.37 0.37 0.63 1 1
evalInf-3 0.74 0.55 0.55 0.45 1 1
evalInf-4 0.86 0.74 0.74 0.26 1 1
evalInf-10 0.88 0.78 0.78 0.22 1 1
evalInf-7 0.81 0.66 0.66 0.34 1 1
evalInf-1 0.82 0.67 0.67 0.33 1 1
evalInf-9 0.80 0.63 0.63 0.37 1 1
With Sums of squares of:
g F1* h2
6.3 0.0 4.1
general/max 1.54 max/min = 7.350603e+16
mean percent general = 1 with sd = 0 and cv of 0
Explained Common Variance of the general factor = 1
The degrees of freedom are 35 and the fit is 0.8
The number of observations was 298 with Chi Square = 233.99 with prob < 2.8e-31
The root mean square of the residuals is 0.05
The df corrected root mean square of the residuals is 0.05
RMSEA index = 0.138 and the 90 % confidence intervals are 0.122 0.155
BIC = 34.59
Compare this with the adequacy of just a general factor and no group factors
The degrees of freedom for just the general factor are 35 and the fit is 0.8
The number of observations was 298 with Chi Square = 233.99 with prob < 2.8e-31
The root mean square of the residuals is 0.05
The df corrected root mean square of the residuals is 0.05
RMSEA index = 0.138 and the 90 % confidence intervals are 0.122 0.155
BIC = 34.59
Measures of factor score adequacy
g F1*
Correlation of scores with factors 0.98 0
Multiple R square of scores with factors 0.95 0
Minimum correlation of factor score estimates 0.90 -1
Total, General and Subset omega for each subset
g F1*
Omega total for total scores and subscales 0.94 0.94
Omega general for total scores and subscales 0.94 0.94
Omega group for total scores and subscales 0.00 0.00omega_results$omega.tot # Total Omega[1] 0.9440978omega_results$omega.h # Hierarchical OmegaNULLomega_results$omega.g # Group Omega (if multiple factors) total general group
g 0.9440978 0.9440534 8.386201e-19
F1* 0.9440534 0.9440534 8.386201e-196.5.2 Situational Interest Scale - Design
regEx <- "Design$"
nameVariable <- "sitIntScale_Design"
sum(str_detect(string = colnames(dat), pattern = regEx))[1] 6tmp_dat <- na.omit(dat[,str_detect(string = colnames(dat), pattern = regEx)])
tmp <- CFAstats(dataset = tmp_dat, regularExp = regEx, labelLatent = str_remove(string = nameVariable, pattern = "mean_"),
showPlots = TRUE,
computeEFA = TRUE,
computeCFA = TRUE,
computeCFAMplus = FALSE)
descriptive statistics:
Mean SD Median CoeffofVariation Minimum Maximun
excitingDesign 4.00 1.68 4 0.42 1 7
entertainingDesign 4.44 1.66 5 0.37 1 7
boringDesign 5.02 1.75 5 0.35 1 7
usefulDesign 5.38 1.30 6 0.24 1 7
unnecessaryDesign 5.90 1.30 6 0.22 1 7
unimportantDesign 5.84 1.31 6 0.23 1 7
Lower Quantile Upper Quantile Skewness Kurtosis(-3) KS-Test
excitingDesign 1 7 -0.05 -0.82 0
entertainingDesign 1 7 -0.31 -0.75 0
boringDesign 1 7 -0.69 -0.46 0
usefulDesign 1 7 -0.91 0.80 0
unnecessaryDesign 1 7 -1.26 1.24 0
unimportantDesign 1 7 -1.15 0.90 0
variables under investigation: excitingDesign entertainingDesign boringDesign usefulDesign unnecessaryDesign unimportantDesign
Cronbachs Alpha: 0.87 
Parallel analysis suggests that the number of factors = 3 and the number of components = 1
sitIntScale_Design
Number of components: 1
EFA factor loadings (1 factor solution):
Loadings:
MR1
excitingDesign 0.758
entertainingDesign 0.818
boringDesign 0.829
usefulDesign 0.689
unnecessaryDesign 0.781
unimportantDesign 0.771
MR1
SS loadings 3.609
Proportion Var 0.602
CFA summary and fit statistics:
lavaan 0.6-19 ended normally after 23 iterations
Estimator ML
Optimization method NLMINB
Number of model parameters 12
Number of observations 298
Model Test User Model:
Standard Scaled
Test Statistic 311.660 173.881
Degrees of freedom 9 9
P-value (Chi-square) 0.000 0.000
Scaling correction factor 1.792
Yuan-Bentler correction (Mplus variant)
Model Test Baseline Model:
Test statistic 1098.414 538.845
Degrees of freedom 15 15
P-value 0.000 0.000
Scaling correction factor 2.038
User Model versus Baseline Model:
Comparative Fit Index (CFI) 0.721 0.685
Tucker-Lewis Index (TLI) 0.534 0.475
Robust Comparative Fit Index (CFI) 0.723
Robust Tucker-Lewis Index (TLI) 0.539
Loglikelihood and Information Criteria:
Loglikelihood user model (H0) -2849.324 -2849.324
Scaling correction factor 1.742
for the MLR correction
Loglikelihood unrestricted model (H1) -2693.494 -2693.494
Scaling correction factor 1.764
for the MLR correction
Akaike (AIC) 5722.647 5722.647
Bayesian (BIC) 5767.012 5767.012
Sample-size adjusted Bayesian (SABIC) 5728.956 5728.956
Root Mean Square Error of Approximation:
RMSEA 0.336 0.248
90 Percent confidence interval - lower 0.304 0.224
90 Percent confidence interval - upper 0.368 0.272
P-value H_0: RMSEA <= 0.050 0.000 0.000
P-value H_0: RMSEA >= 0.080 1.000 1.000
Robust RMSEA 0.332
90 Percent confidence interval - lower 0.290
90 Percent confidence interval - upper 0.376
P-value H_0: Robust RMSEA <= 0.050 0.000
P-value H_0: Robust RMSEA >= 0.080 1.000
Standardized Root Mean Square Residual:
SRMR 0.125 0.125
Parameter Estimates:
Standard errors Sandwich
Information bread Observed
Observed information based on Hessian
Latent Variables:
Estimate Std.Err z-value P(>|z|) Std.lv Std.all
sitIntScale_Design =~
excitingDesign 1.000 1.389 0.830
entertanngDsgn 1.050 0.040 25.959 0.000 1.458 0.880
boringDesign 0.996 0.086 11.612 0.000 1.384 0.794
usefulDesign 0.555 0.071 7.761 0.000 0.771 0.594
unnecessryDsgn 0.542 0.098 5.553 0.000 0.753 0.580
unimportntDsgn 0.563 0.096 5.840 0.000 0.782 0.596
Variances:
Estimate Std.Err z-value P(>|z|) Std.lv Std.all
.excitingDesign 0.872 0.171 5.094 0.000 0.872 0.311
.entertanngDsgn 0.617 0.166 3.705 0.000 0.617 0.225
.boringDesign 1.122 0.232 4.841 0.000 1.122 0.369
.usefulDesign 1.091 0.146 7.483 0.000 1.091 0.648
.unnecessryDsgn 1.117 0.178 6.291 0.000 1.117 0.663
.unimportntDsgn 1.110 0.183 6.063 0.000 1.110 0.645
sitIntScl_Dsgn 1.930 0.241 8.024 0.000 1.000 1.000
CFA first 6 Modification Indices:
lhs op rhs mi epc sepc.lv sepc.all
28 unnecessaryDesign ~~ unimportantDesign 165.022 0.888 0.888 0.797
14 excitingDesign ~~ entertainingDesign 102.910 0.958 0.958 1.306
17 excitingDesign ~~ unnecessaryDesign 43.094 -0.467 -0.467 -0.473
18 excitingDesign ~~ unimportantDesign 39.251 -0.447 -0.447 -0.455
21 entertainingDesign ~~ unnecessaryDesign 37.256 -0.415 -0.415 -0.501
26 usefulDesign ~~ unnecessaryDesign 27.797 0.361 0.361 0.327
sepc.nox
28 0.797
14 1.306
17 -0.473
18 -0.455
21 -0.501
26 0.327des_tab <- tmp$desTable %>%
as.data.frame() %>%
select(Mean, SD, Skewness, `Kurtosis(-3)`, `KS-Test`)
stargazer(
des_tab,
summary = FALSE,
rownames = TRUE,
title = "Descriptive Statistics for Situational Interest Design Items",
label = "tab:ecology_desc",
digits = 2,
table.placement = "ht!",
font.size = "small"
)
% Table created by stargazer v.5.2.3 by Marek Hlavac, Social Policy Institute. E-mail: marek.hlavac at gmail.com
% Date and time: Do, Dez 18, 2025 - 11:03:15
\begin{table}[ht!] \centering
\caption{Descriptive Statistics for Situational Interest Design Items}
\label{tab:ecology_desc}
\small
\begin{tabular}{@{\extracolsep{5pt}} cccccc}
\\[-1.8ex]\hline
\hline \\[-1.8ex]
& Mean & SD & Skewness & Kurtosis(-3) & KS-Test \\
\hline \\[-1.8ex]
excitingDesign & $4$ & $1.68$ & $$-$0.05$ & $$-$0.82$ & $0$ \\
entertainingDesign & $4.44$ & $1.66$ & $$-$0.31$ & $$-$0.75$ & $0$ \\
boringDesign & $5.02$ & $1.75$ & $$-$0.69$ & $$-$0.46$ & $0$ \\
usefulDesign & $5.38$ & $1.30$ & $$-$0.91$ & $0.80$ & $0$ \\
unnecessaryDesign & $5.90$ & $1.30$ & $$-$1.26$ & $1.24$ & $0$ \\
unimportantDesign & $5.84$ & $1.31$ & $$-$1.15$ & $0.90$ & $0$ \\
\hline \\[-1.8ex]
\end{tabular}
\end{table} omega_results <- psych::omega(tmp_dat, nfactors = 1) # or more if needed
omega_resultsOmega
Call: omegah(m = m, nfactors = nfactors, fm = fm, key = key, flip = flip,
digits = digits, title = title, sl = sl, labels = labels,
plot = plot, n.obs = n.obs, rotate = rotate, Phi = Phi, option = option,
covar = covar)
Alpha: 0.87
G.6: 0.9
Omega Hierarchical: 0.87
Omega H asymptotic: 1
Omega Total 0.87
Schmid Leiman Factor loadings greater than 0.2
g F1* h2 h2 u2 p2 com
excitingDesign 0.74 0.54 0.54 0.46 1 1
entertainingDesign 0.81 0.65 0.65 0.35 1 1
boringDesign 0.79 0.63 0.63 0.37 1 1
usefulDesign 0.63 0.40 0.40 0.60 1 1
unnecessaryDesign 0.70 0.49 0.49 0.51 1 1
unimportantDesign 0.71 0.50 0.50 0.50 1 1
With Sums of squares of:
g F1* h2
3.2 0.0 1.8
general/max 1.82 max/min = Inf
mean percent general = 1 with sd = 0 and cv of 0
Explained Common Variance of the general factor = 1
The degrees of freedom are 9 and the fit is 1.1
The number of observations was 298 with Chi Square = 323.15 with prob < 3.2e-64
The root mean square of the residuals is 0.13
The df corrected root mean square of the residuals is 0.17
RMSEA index = 0.342 and the 90 % confidence intervals are 0.311 0.375
BIC = 271.88
Compare this with the adequacy of just a general factor and no group factors
The degrees of freedom for just the general factor are 9 and the fit is 1.1
The number of observations was 298 with Chi Square = 323.15 with prob < 3.2e-64
The root mean square of the residuals is 0.13
The df corrected root mean square of the residuals is 0.17
RMSEA index = 0.342 and the 90 % confidence intervals are 0.311 0.375
BIC = 271.88
Measures of factor score adequacy
g F1*
Correlation of scores with factors 0.94 0
Multiple R square of scores with factors 0.88 0
Minimum correlation of factor score estimates 0.76 -1
Total, General and Subset omega for each subset
g F1*
Omega total for total scores and subscales 0.87 0.87
Omega general for total scores and subscales 0.87 0.87
Omega group for total scores and subscales 0.00 0.00omega_results$omega.tot # Total Omega[1] 0.8726258omega_results$omega.h # Hierarchical OmegaNULLomega_results$omega.g # Group Omega (if multiple factors) total general group
g 0.8726258 0.8722623 0
F1* 0.8722623 0.8722623 06.5.3 Situational Interest Scale - Topic
regEx <- "Topic$"
nameVariable <- "sitIntScale_Topic"
sum(str_detect(string = colnames(dat), pattern = regEx))[1] 6tmp_dat <- na.omit(dat[,str_detect(string = colnames(dat), pattern = regEx)])
tmp <- CFAstats(dataset = tmp_dat, regularExp = regEx, labelLatent = str_remove(string = nameVariable, pattern = "mean_"),
showPlots = TRUE,
computeEFA = TRUE,
computeCFA = TRUE,
computeCFAMplus = FALSE)
descriptive statistics:
Mean SD Median CoeffofVariation Minimum Maximun
excitingTopic 4.73 1.68 5 0.36 1 7
entertainingTopic 4.73 1.60 5 0.34 1 7
boringTopic 5.56 1.70 6 0.31 1 7
usefulTopic 5.18 1.43 5 0.28 1 7
unnecessaryTopic 5.94 1.34 6 0.23 1 7
unimportantTopic 5.98 1.30 6 0.22 1 7
Lower Quantile Upper Quantile Skewness Kurtosis(-3) KS-Test
excitingTopic 1 7 -0.57 -0.48 0
entertainingTopic 1 7 -0.58 -0.30 0
boringTopic 1 7 -1.13 0.24 0
usefulTopic 1 7 -0.83 0.55 0
unnecessaryTopic 1 7 -1.48 2.03 0
unimportantTopic 1 7 -1.35 1.51 0
variables under investigation: excitingTopic entertainingTopic boringTopic usefulTopic unnecessaryTopic unimportantTopic
Cronbachs Alpha: 0.91 
Parallel analysis suggests that the number of factors = 2 and the number of components = 1
sitIntScale_Topic
Number of components: 1
EFA factor loadings (1 factor solution):
Loadings:
MR1
excitingTopic 0.825
entertainingTopic 0.823
boringTopic 0.900
usefulTopic 0.695
unnecessaryTopic 0.862
unimportantTopic 0.874
MR1
SS loadings 4.158
Proportion Var 0.693
CFA summary and fit statistics:
lavaan 0.6-19 ended normally after 32 iterations
Estimator ML
Optimization method NLMINB
Number of model parameters 12
Number of observations 298
Model Test User Model:
Standard Scaled
Test Statistic 429.130 413.324
Degrees of freedom 9 9
P-value (Chi-square) 0.000 0.000
Scaling correction factor 1.038
Yuan-Bentler correction (Mplus variant)
Model Test Baseline Model:
Test statistic 1511.962 651.470
Degrees of freedom 15 15
P-value 0.000 0.000
Scaling correction factor 2.321
User Model versus Baseline Model:
Comparative Fit Index (CFI) 0.719 0.365
Tucker-Lewis Index (TLI) 0.532 -0.059
Robust Comparative Fit Index (CFI) 0.716
Robust Tucker-Lewis Index (TLI) 0.526
Loglikelihood and Information Criteria:
Loglikelihood user model (H0) -2718.166 -2718.166
Scaling correction factor 2.771
for the MLR correction
Loglikelihood unrestricted model (H1) -2503.601 -2503.601
Scaling correction factor 2.028
for the MLR correction
Akaike (AIC) 5460.331 5460.331
Bayesian (BIC) 5504.697 5504.697
Sample-size adjusted Bayesian (SABIC) 5466.640 5466.640
Root Mean Square Error of Approximation:
RMSEA 0.396 0.388
90 Percent confidence interval - lower 0.364 0.357
90 Percent confidence interval - upper 0.428 0.420
P-value H_0: RMSEA <= 0.050 0.000 0.000
P-value H_0: RMSEA >= 0.080 1.000 1.000
Robust RMSEA 0.396
90 Percent confidence interval - lower 0.364
90 Percent confidence interval - upper 0.429
P-value H_0: Robust RMSEA <= 0.050 0.000
P-value H_0: Robust RMSEA >= 0.080 1.000
Standardized Root Mean Square Residual:
SRMR 0.143 0.143
Parameter Estimates:
Standard errors Sandwich
Information bread Observed
Observed information based on Hessian
Latent Variables:
Estimate Std.Err z-value P(>|z|) Std.lv Std.all
sitIntScale_Topic =~
excitingTopic 1.000 1.032 0.614
entertainngTpc 0.962 0.043 22.600 0.000 0.993 0.621
boringTopic 1.238 0.103 11.976 0.000 1.278 0.754
usefulTopic 0.804 0.080 10.054 0.000 0.829 0.581
unnecessaryTpc 1.218 0.158 7.707 0.000 1.257 0.936
unimportantTpc 1.196 0.152 7.865 0.000 1.234 0.952
Variances:
Estimate Std.Err z-value P(>|z|) Std.lv Std.all
.excitingTopic 1.757 0.229 7.690 0.000 1.757 0.623
.entertainngTpc 1.572 0.202 7.774 0.000 1.572 0.615
.boringTopic 1.238 0.205 6.029 0.000 1.238 0.431
.usefulTopic 1.346 0.196 6.861 0.000 1.346 0.662
.unnecessaryTpc 0.222 0.105 2.124 0.034 0.222 0.123
.unimportantTpc 0.159 0.072 2.218 0.027 0.159 0.094
sitIntScal_Tpc 1.065 0.243 4.383 0.000 1.000 1.000
CFA first 6 Modification Indices:
lhs op rhs mi epc sepc.lv sepc.all
28 unnecessaryTopic ~~ unimportantTopic 349.451 1.061 1.061 5.648
14 excitingTopic ~~ entertainingTopic 178.389 1.331 1.331 0.801
19 entertainingTopic ~~ boringTopic 91.210 0.817 0.817 0.586
15 excitingTopic ~~ boringTopic 79.384 0.805 0.805 0.546
17 excitingTopic ~~ unnecessaryTopic 41.941 -0.325 -0.325 -0.520
22 entertainingTopic ~~ unimportantTopic 37.150 -0.278 -0.278 -0.557
sepc.nox
28 5.648
14 0.801
19 0.586
15 0.546
17 -0.520
22 -0.557des_tab <- tmp$desTable %>%
as.data.frame() %>%
select(Mean, SD, Skewness, `Kurtosis(-3)`, `KS-Test`)
stargazer(
des_tab,
summary = FALSE,
rownames = TRUE,
title = "Descriptive Statistics for Situational Interest Topic Items",
label = "tab:ecology_desc",
digits = 2,
table.placement = "ht!",
font.size = "small"
)
% Table created by stargazer v.5.2.3 by Marek Hlavac, Social Policy Institute. E-mail: marek.hlavac at gmail.com
% Date and time: Do, Dez 18, 2025 - 11:03:25
\begin{table}[ht!] \centering
\caption{Descriptive Statistics for Situational Interest Topic Items}
\label{tab:ecology_desc}
\small
\begin{tabular}{@{\extracolsep{5pt}} cccccc}
\\[-1.8ex]\hline
\hline \\[-1.8ex]
& Mean & SD & Skewness & Kurtosis(-3) & KS-Test \\
\hline \\[-1.8ex]
excitingTopic & $4.73$ & $1.68$ & $$-$0.57$ & $$-$0.48$ & $0$ \\
entertainingTopic & $4.73$ & $1.60$ & $$-$0.58$ & $$-$0.30$ & $0$ \\
boringTopic & $5.56$ & $1.70$ & $$-$1.13$ & $0.24$ & $0$ \\
usefulTopic & $5.18$ & $1.43$ & $$-$0.83$ & $0.55$ & $0$ \\
unnecessaryTopic & $5.94$ & $1.34$ & $$-$1.48$ & $2.03$ & $0$ \\
unimportantTopic & $5.98$ & $1.30$ & $$-$1.35$ & $1.51$ & $0$ \\
\hline \\[-1.8ex]
\end{tabular}
\end{table} omega_results <- psych::omega(tmp_dat, nfactors = 1) # or more if needed
omega_resultsOmega
Call: omegah(m = m, nfactors = nfactors, fm = fm, key = key, flip = flip,
digits = digits, title = title, sl = sl, labels = labels,
plot = plot, n.obs = n.obs, rotate = rotate, Phi = Phi, option = option,
covar = covar)
Alpha: 0.91
G.6: 0.93
Omega Hierarchical: 0.91
Omega H asymptotic: 1
Omega Total 0.91
Schmid Leiman Factor loadings greater than 0.2
g F1* h2 h2 u2 p2 com
excitingTopic 0.80 0.64 0.64 0.36 1 1
entertainingTopic 0.80 0.65 0.65 0.35 1 1
boringTopic 0.85 0.73 0.73 0.27 1 1
usefulTopic 0.63 0.40 0.40 0.60 1 1
unnecessaryTopic 0.80 0.64 0.64 0.36 1 1
unimportantTopic 0.82 0.68 0.68 0.32 1 1
With Sums of squares of:
g F1* h2
3.7 0.0 2.4
general/max 1.56 max/min = Inf
mean percent general = 1 with sd = 0 and cv of 0
Explained Common Variance of the general factor = 1
The degrees of freedom are 9 and the fit is 1.51
The number of observations was 298 with Chi Square = 443.59 with prob < 6.7e-90
The root mean square of the residuals is 0.11
The df corrected root mean square of the residuals is 0.14
RMSEA index = 0.403 and the 90 % confidence intervals are 0.372 0.436
BIC = 392.32
Compare this with the adequacy of just a general factor and no group factors
The degrees of freedom for just the general factor are 9 and the fit is 1.51
The number of observations was 298 with Chi Square = 443.59 with prob < 6.7e-90
The root mean square of the residuals is 0.11
The df corrected root mean square of the residuals is 0.14
RMSEA index = 0.403 and the 90 % confidence intervals are 0.372 0.436
BIC = 392.32
Measures of factor score adequacy
g F1*
Correlation of scores with factors 0.96 0
Multiple R square of scores with factors 0.92 0
Minimum correlation of factor score estimates 0.83 -1
Total, General and Subset omega for each subset
g F1*
Omega total for total scores and subscales 0.91 0.91
Omega general for total scores and subscales 0.91 0.91
Omega group for total scores and subscales 0.00 0.00omega_results$omega.tot # Total Omega[1] 0.9072878omega_results$omega.h # Hierarchical OmegaNULLomega_results$omega.g # Group Omega (if multiple factors) total general group
g 0.9072878 0.9072105 0
F1* 0.9072105 0.9072105 06.6 Item Response Theory (polytomous) for “Perceived Bio-Inspiration Scale (PBS)”
Factor Loadings (F1) indicate how strongly each item is associated with the latent trait, rule of thumb:
- 0.70 = strong
- 0.40–0.69 = moderate
- < 0.40 = weak
Communality (h²) is the proportion of variance in each item explained by the factor, rule of thumb: + h² > 0.40 → item is well represented + h² < 0.30 → potentially problematic item
if(runIRTmodels){
# Choose dataset and regular expression
regEx <- "^Bioinspiration"
# Filter variables matching the pattern
irt_items <- dat[, str_detect(colnames(dat), pattern = regEx)]
# Drop rows with missing data (mirt requires complete cases)
irt_items <- na.omit(irt_items)
# Ensure all items are treated as ordered factors
irt_items[] <- lapply(irt_items, function(x) as.numeric(as.character(x)))
# Fit Graded Response Model (1-factor)
mod_grm <- mirt(data = irt_items, model = 1, itemtype = "graded", verbose = FALSE)
# Summarize model
summary(mod_grm)
# Plot Item Characteristic Curves (ICCs) for all items
plot(mod_grm, type = "trace", facet_items = TRUE, main = "Item Characteristic Curves")
# Plot Test Information Curve
plot(mod_grm, type = "info", main = "Test Information Curve: Bioinspiration")
### compare results to:
cor.plot(r = cor(irt_items))
}Compare 1-Factor vs. 2-Factor Models:
if(runIRTmodels){
mod_1f <- mirt(data = irt_items, model = 1, itemtype = "graded", verbose = FALSE)
mod_2f <- mirt(data = irt_items, model = 2, itemtype = "graded", verbose = FALSE)
mod_3f <- mirt(data = irt_items, model = 3, itemtype = "graded", verbose = FALSE)
anova(mod_1f, mod_2f, mod_3f)
summary(mod_2f)
summary(mod_3f)
}significant p-value (e.g., < .05) supports the X-factor model.
7 Compute mean scores
dat$mean_Bioinspiration <- rowMeans(x = dat[,str_subset(colnames(dat), pattern = "^Bioinspiration")])
dat$mean_Bioinspiration_PN <- rowMeans(x = dat[,str_subset(colnames(dat), pattern = "^Bioinspiration-PN")])
dat$mean_Bioinspiration_IPI <- rowMeans(x = dat[,str_subset(colnames(dat), pattern = "^Bioinspiration-IPI")])
dat$mean_Bioinspiration_VRtN <- rowMeans(x = dat[,str_subset(colnames(dat), pattern = "^Bioinspiration-VRtN")])
dat$mean_Ecological <- rowMeans(x = dat[,str_subset(colnames(dat), pattern = "^EcologicalDimension")])
dat$mean_GAToRS_pp <- rowMeans(x = dat[,str_subset(colnames(dat), pattern = "^GAToRS.*pp$")])
dat$mean_GAToRS_pn <- rowMeans(x = dat[,str_subset(colnames(dat), pattern = "^GAToRS.*pn$")])
dat$mean_GAToRS_sp <- rowMeans(x = dat[,str_subset(colnames(dat), pattern = "^GAToRS.*sp$")])
dat$mean_GAToRS_sn <- rowMeans(x = dat[,str_subset(colnames(dat), pattern = "^GAToRS.*sn$")])
dat$mean_video_evalInf <- rowMeans(x = dat[,str_subset(colnames(dat), pattern = "^evalInf")])
dat$mean_video_sitintTopic <- rowMeans(x = dat[,str_subset(colnames(dat), pattern = "Topic$")])
dat$mean_video_sitintDesign <- rowMeans(x = dat[,str_subset(colnames(dat), pattern = "Design$")])7.1 manifest correlations:
psych::cor.plot(r = cor(dat[, str_detect(string = colnames(dat),
pattern = "^mean_")]
, use = "pairwise.complete.obs"),
upper = FALSE, xlas = 2, main = "Overall")
psych::cor.plot(r = cor(dat[dat$framingCondition == "bio-inspired", str_detect(string = colnames(dat),
pattern = "^mean_")]
, use = "pairwise.complete.obs"),
upper = FALSE, xlas = 2, main = "For subset bio-inspired")
plot(dat[dat$framingCondition == "bio-inspired", "mean_Ecological"], dat[dat$framingCondition == "bio-inspired", "mean_Bioinspiration_IPI"]) # PN most strongly related to sustainability
cor(dat[dat$framingCondition == "bio-inspired", "mean_Ecological"], dat[dat$framingCondition == "bio-inspired", "mean_Bioinspiration_PN"])[1] 0.4648864psych::cor.plot(r = cor(dat[dat$framingCondition == "tech-inspired", str_detect(string = colnames(dat),
pattern = "^mean_")]
, use = "pairwise.complete.obs"),
upper = FALSE, xlas = 2, main = "For subset tech-inspired")
7.2 descriptive:
dat %>%
group_by(framingCondition) %>%
dplyr::summarise(
N = n(),
mean_Eco = mean(mean_Ecological, na.rm = TRUE),
sd_Eco = sd(mean_Ecological, na.rm = TRUE),
mean_BioOverall = mean(mean_Bioinspiration, na.rm = TRUE),
sd_BioOverall = sd(mean_Bioinspiration, na.rm = TRUE),
mean_Bio_PN = mean(mean_Bioinspiration_PN, na.rm = TRUE),
sd_Bio_PN = sd(mean_Bioinspiration_PN, na.rm = TRUE),
mean_Bio_IPI = mean(mean_Bioinspiration_IPI, na.rm = TRUE),
sd_Bio_IPI = sd(mean_Bioinspiration_IPI, na.rm = TRUE),
mean_Bio_VRtN = mean(mean_Bioinspiration_VRtN, na.rm = TRUE),
sd_Bio_VRtN = sd(mean_Bioinspiration_VRtN, na.rm = TRUE)
)# A tibble: 2 × 12
framingCondition N mean_Eco sd_Eco mean_BioOverall sd_BioOverall
<fct> <int> <dbl> <dbl> <dbl> <dbl>
1 bio-inspired 160 5.62 1.05 5.02 0.937
2 tech-inspired 138 5.53 1.09 4.85 1.04
# ℹ 6 more variables: mean_Bio_PN <dbl>, sd_Bio_PN <dbl>, mean_Bio_IPI <dbl>,
# sd_Bio_IPI <dbl>, mean_Bio_VRtN <dbl>, sd_Bio_VRtN <dbl>psych::describe(x = dat[, c("mean_video_evalInf", "mean_video_sitintTopic", "mean_video_sitintDesign")]) vars n mean sd median trimmed mad min max range
mean_video_evalInf 1 298 4.78 0.88 5.00 4.86 0.74 1.3 6 4.7
mean_video_sitintTopic 2 298 5.35 1.25 5.67 5.47 1.24 1.0 7 6.0
mean_video_sitintDesign 3 298 5.09 1.18 5.17 5.15 1.24 1.0 7 6.0
skew kurtosis se
mean_video_evalInf -0.93 0.87 0.05
mean_video_sitintTopic -0.89 0.50 0.07
mean_video_sitintDesign -0.46 -0.32 0.07hist(dat$mean_video_evalInf)
hist(dat$mean_video_sitintTopic)
hist(dat$mean_video_sitintDesign)
psych::cor.plot(r = cor(dat[, c("mean_video_evalInf", "mean_video_sitintTopic", "mean_video_sitintDesign")]
, use = "pairwise.complete.obs"),
upper = FALSE, xlas = 2, main = "Overall")
8 Test Hypotheses
8.1 Descriptive
# Summaries of participant-level scores by framing condition
eco_summary <- data_summary(dat, "mean_Ecological", "framingCondition")Lade nötiges Paket: plyr------------------------------------------------------------------------------You have loaded plyr after dplyr - this is likely to cause problems.
If you need functions from both plyr and dplyr, please load plyr first, then dplyr:
library(plyr); library(dplyr)------------------------------------------------------------------------------
Attache Paket: 'plyr'Die folgenden Objekte sind maskiert von 'package:dplyr':
arrange, count, desc, failwith, id, mutate, rename, summarise,
summarizeDas folgende Objekt ist maskiert 'package:purrr':
compactbio_summary <- data_summary(dat, "mean_Bioinspiration", "framingCondition")
# View results
print(eco_summary) framingCondition mean_Ecological se
1 bio-inspired 5.623437 0.08264248
2 tech-inspired 5.528986 0.09246271print(bio_summary) framingCondition mean_Bioinspiration se
1 bio-inspired 5.019886 0.07408534
2 tech-inspired 4.845850 0.08876130# Plots the mean scores on the Bioinspiration & Ecological Dimension by Framing Condition
ggplot(dat, aes(x = framingCondition, y = mean_Ecological)) +
geom_boxplot(fill = "lightgreen") +
labs(title = "Ecological Dimension by Framing", y = "Mean Score") +
theme_minimal()
ggplot(dat, aes(x = framingCondition, y = mean_Bioinspiration)) +
geom_boxplot(fill = "skyblue") +
labs(title = "Bioinspiration by Framing", y = "Mean Score") +
theme_minimal()
8.2 ANOVAs
ANOVAs + post hoc tests:
8.2.1 for Perceived Ecological Sustainability Scale (PES)
# --- ANOVA for Ecological Dimension - PN ---
aov_out <- aov_ez(
id = "PROLIFIC_PID", # replace with your participant ID column name
dv = "mean_Ecological",
data = dat,
between = "framingCondition"
)
print(aov_out)Anova Table (Type 3 tests)
Response: mean_Ecological
Effect df MSE F ges p.value
1 framingCondition 1, 296 1.13 0.58 .002 .446
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '+' 0.1 ' ' 1# Post hoc (Tukey) for Ecological
em_eco <- emmeans(aov_out, "framingCondition")
eco_posthoc <- pairs(em_eco, adjust = "tukey")
print(eco_posthoc) contrast estimate SE df t.ratio p.value
(bio-inspired) - (tech-inspired) 0.0945 0.124 296 0.764 0.4456# Summarize means and SE for plotting
plot_data <- data_summary(dat, "mean_Ecological", "framingCondition")
# --- Plot ---
ggplot(plot_data, aes(x = framingCondition, y = mean_Ecological)) +
geom_col(fill = "grey80", color = "black", width = 0.6) +
geom_errorbar(aes(ymin = mean_Ecological - se, ymax = mean_Ecological + se), width = 0.15) +
labs(x = "Framing Condition", y = "Mean PES Score") +
theme_apa() +
theme(
axis.title = element_text(face = "bold"),
legend.position = "none"
)
8.2.2 for Perceived Bio-Inspiration Scale (PBS) - overall
# --- ANOVA for Ecological Dimension - PN ---
aov_out <- aov_ez(
id = "PROLIFIC_PID", # replace with your participant ID column name
dv = "mean_Bioinspiration",
data = dat,
between = "framingCondition"
)
print(aov_out)Anova Table (Type 3 tests)
Response: mean_Bioinspiration
Effect df MSE F ges p.value
1 framingCondition 1, 296 0.97 2.30 .008 .130
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '+' 0.1 ' ' 1# Post hoc (Tukey) for Ecological
em_eco <- emmeans(aov_out, "framingCondition")
eco_posthoc <- pairs(em_eco, adjust = "tukey")
print(eco_posthoc) contrast estimate SE df t.ratio p.value
(bio-inspired) - (tech-inspired) 0.174 0.115 296 1.517 0.1303# Summarize means and SE for plotting
plot_data <- data_summary(dat, "mean_Bioinspiration", "framingCondition")
# --- Plot ---
ggplot(plot_data, aes(x = framingCondition, y = mean_Bioinspiration)) +
geom_col(fill = "grey80", color = "black", width = 0.6) +
geom_errorbar(aes(ymin = mean_Bioinspiration - se, ymax = mean_Bioinspiration + se), width = 0.15) +
labs(x = "Framing Condition", y = "Mean PBS Score") +
theme_apa() +
theme(
axis.title = element_text(face = "bold"),
legend.position = "none"
)
8.2.3 for PBS - Perceived Naturalness (PN)
# --- ANOVA for Ecological Dimension - PN ---
aov_out <- aov_ez(
id = "PROLIFIC_PID", # replace with your participant ID column name
dv = "mean_Bioinspiration_PN",
data = dat,
between = "framingCondition"
)
print(aov_out)Anova Table (Type 3 tests)
Response: mean_Bioinspiration_PN
Effect df MSE F ges p.value
1 framingCondition 1, 296 2.18 2.27 .008 .133
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '+' 0.1 ' ' 1# Post hoc (Tukey) for Ecological
em_eco <- emmeans(aov_out, "framingCondition")
eco_posthoc <- pairs(em_eco, adjust = "tukey")
print(eco_posthoc) contrast estimate SE df t.ratio p.value
(bio-inspired) - (tech-inspired) -0.259 0.172 296 -1.506 0.1332# Summarize means and SE for plotting
plot_data <- data_summary(dat, "mean_Bioinspiration_PN", "framingCondition")
# --- Plot ---
ggplot(plot_data, aes(x = framingCondition, y = mean_Bioinspiration_PN)) +
geom_col(fill = "grey80", color = "black", width = 0.6) +
geom_errorbar(aes(ymin = mean_Bioinspiration_PN - se, ymax = mean_Bioinspiration_PN + se), width = 0.15) +
labs(x = "Framing Condition", y = "Mean PN Score") +
theme_apa() +
theme(
axis.title = element_text(face = "bold"),
legend.position = "none"
)
8.2.4 for PBS - Intentionality & Perceived Inspiration (IPI)
# --- ANOVA for Ecological Dimension - PN ---
aov_out <- aov_ez(
id = "PROLIFIC_PID", # replace with your participant ID column name
dv = "mean_Bioinspiration_IPI",
data = dat,
between = "framingCondition"
)
print(aov_out)Anova Table (Type 3 tests)
Response: mean_Bioinspiration_IPI
Effect df MSE F ges p.value
1 framingCondition 1, 296 0.93 25.36 *** .079 <.001
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '+' 0.1 ' ' 1# Post hoc (Tukey) for Ecological
em_eco <- emmeans(aov_out, "framingCondition")
eco_posthoc <- pairs(em_eco, adjust = "tukey")
print(eco_posthoc) contrast estimate SE df t.ratio p.value
(bio-inspired) - (tech-inspired) 0.563 0.112 296 5.036 <.0001# Summarize means and SE for plotting
plot_data <- data_summary(dat, "mean_Bioinspiration_IPI", "framingCondition")
# --- Plot ---
ggplot(plot_data, aes(x = framingCondition, y = mean_Bioinspiration_IPI)) +
geom_col(fill = "grey80", color = "black", width = 0.6) +
geom_errorbar(aes(ymin = mean_Bioinspiration_IPI - se, ymax = mean_Bioinspiration_IPI + se), width = 0.15) +
labs(x = "Framing Condition", y = "Mean IPI Score") +
theme_apa() +
theme(
axis.title = element_text(face = "bold"),
legend.position = "none"
)
8.2.5 for PBS - Visual Resemblance to Nature (VRtN)
# --- ANOVA for Ecological Dimension - PN ---
aov_out <- aov_ez(
id = "PROLIFIC_PID", # replace with your participant ID column name
dv = "mean_Bioinspiration_VRtN",
data = dat,
between = "framingCondition"
)
print(aov_out)Anova Table (Type 3 tests)
Response: mean_Bioinspiration_VRtN
Effect df MSE F ges p.value
1 framingCondition 1, 296 1.51 0.59 .002 .444
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '+' 0.1 ' ' 1# Post hoc (Tukey) for Ecological
em_eco <- emmeans(aov_out, "framingCondition")
eco_posthoc <- pairs(em_eco, adjust = "tukey")
print(eco_posthoc) contrast estimate SE df t.ratio p.value
(bio-inspired) - (tech-inspired) 0.11 0.143 296 0.766 0.4441# Summarize means and SE for plotting
plot_data <- data_summary(dat, "mean_Bioinspiration_VRtN", "framingCondition")
# --- Plot ---
ggplot(plot_data, aes(x = framingCondition, y = mean_Bioinspiration_VRtN)) +
geom_col(fill = "grey80", color = "black", width = 0.6) +
geom_errorbar(aes(ymin = mean_Bioinspiration_VRtN - se, ymax = mean_Bioinspiration_VRtN + se), width = 0.15) +
labs(x = "Framing Condition", y = "Mean VRtN Score") +
theme_apa() +
theme(
axis.title = element_text(face = "bold"),
legend.position = "none"
)
8.3 Spillover
We are comparing the effect size or magnitude of:
- How much “bioinspired” framing boosts sustainability ratings.
- How much “sustainable” framing boosts bioinspiration ratings.
# Subset only relevant cases and variables
dat_subset <- dat %>%
# filter(framingCondition %in% c("bioinspired", "sustainable")) %>%
select(PROLIFIC_PID, framingCondition, mean_Bioinspiration, mean_Ecological)
# Convert to long format (NO z-scores)
dat_long <- dat_subset %>%
pivot_longer(
cols = c(mean_Bioinspiration, mean_Ecological),
names_to = "ratingType",
values_to = "ratingScore"
) %>%
mutate(
ratingType = dplyr::recode(
ratingType,
"mean_Bioinspiration" = "Bioinspiration",
"mean_Ecological" = "Sustainability"
),
framingCondition = factor(framingCondition),
ratingType = factor(ratingType)
)
dat_long$ratingType <- as.factor(dat_long$ratingType)The interaction term now reflects difference in effect sizes in standard deviation units (comparable spillover strength):
levels(dat_long$framingCondition)[1] "bio-inspired" "tech-inspired"levels(dat_long$ratingType)[1] "Bioinspiration" "Sustainability"# Run interaction model
model_lm <- lm(ratingScore ~ framingCondition * ratingType, data = dat_long)
summary(model_lm)
Call:
lm(formula = ratingScore ~ framingCondition * ratingType, data = dat_long)
Residuals:
Min 1Q Median 3Q Max
-3.2790 -0.6563 0.1266 0.7210 2.1542
Coefficients:
Estimate Std. Error
(Intercept) 5.01989 0.08116
framingConditiontech-inspired -0.17404 0.11927
ratingTypeSustainability 0.60355 0.11478
framingConditiontech-inspired:ratingTypeSustainability 0.07958 0.16867
t value Pr(>|t|)
(Intercept) 61.849 < 2e-16 ***
framingConditiontech-inspired -1.459 0.145
ratingTypeSustainability 5.258 2.03e-07 ***
framingConditiontech-inspired:ratingTypeSustainability 0.472 0.637
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 1.027 on 592 degrees of freedom
Multiple R-squared: 0.09304, Adjusted R-squared: 0.08845
F-statistic: 20.24 on 3 and 592 DF, p-value: 1.68e-12stargazer(model_lm)
% Table created by stargazer v.5.2.3 by Marek Hlavac, Social Policy Institute. E-mail: marek.hlavac at gmail.com
% Date and time: Do, Dez 18, 2025 - 11:03:30
\begin{table}[!htbp] \centering
\caption{}
\label{}
\begin{tabular}{@{\extracolsep{5pt}}lc}
\\[-1.8ex]\hline
\hline \\[-1.8ex]
& \multicolumn{1}{c}{\textit{Dependent variable:}} \\
\cline{2-2}
\\[-1.8ex] & ratingScore \\
\hline \\[-1.8ex]
framingConditiontech-inspired & $-$0.174 \\
& (0.119) \\
& \\
ratingTypeSustainability & 0.604$^{***}$ \\
& (0.115) \\
& \\
framingConditiontech-inspired:ratingTypeSustainability & 0.080 \\
& (0.169) \\
& \\
Constant & 5.020$^{***}$ \\
& (0.081) \\
& \\
\hline \\[-1.8ex]
Observations & 596 \\
R$^{2}$ & 0.093 \\
Adjusted R$^{2}$ & 0.088 \\
Residual Std. Error & 1.027 (df = 592) \\
F Statistic & 20.245$^{***}$ (df = 3; 592) \\
\hline
\hline \\[-1.8ex]
\textit{Note:} & \multicolumn{1}{r}{$^{*}$p$<$0.1; $^{**}$p$<$0.05; $^{***}$p$<$0.01} \\
\end{tabular}
\end{table} no differences in mean scores between groups, only changes in variance:
library(lme4)
library(lmerTest)
Attache Paket: 'lmerTest'Das folgende Objekt ist maskiert 'package:lme4':
lmerDas folgende Objekt ist maskiert 'package:stats':
steplibrary(performance)
model_mixed <- lmer(
ratingScore ~ framingCondition * ratingType +
(1 | PROLIFIC_PID),
data = dat_long
)
icc(model_mixed)# Intraclass Correlation Coefficient
Adjusted ICC: 0.444
Unadjusted ICC: 0.403summary(model_mixed)Linear mixed model fit by REML. t-tests use Satterthwaite's method [
lmerModLmerTest]
Formula: ratingScore ~ framingCondition * ratingType + (1 | PROLIFIC_PID)
Data: dat_long
REML criterion at convergence: 1666.2
Scaled residuals:
Min 1Q Median 3Q Max
-3.0657 -0.5057 0.1117 0.5749 1.9990
Random effects:
Groups Name Variance Std.Dev.
PROLIFIC_PID (Intercept) 0.4679 0.6840
Residual 0.5861 0.7656
Number of obs: 596, groups: PROLIFIC_PID, 298
Fixed effects:
Estimate Std. Error
(Intercept) 5.01989 0.08116
framingConditiontech-inspired -0.17404 0.11927
ratingTypeSustainability 0.60355 0.08559
framingConditiontech-inspired:ratingTypeSustainability 0.07958 0.12578
df t value
(Intercept) 494.54184 61.849
framingConditiontech-inspired 494.54184 -1.459
ratingTypeSustainability 296.00001 7.051
framingConditiontech-inspired:ratingTypeSustainability 296.00001 0.633
Pr(>|t|)
(Intercept) < 2e-16 ***
framingConditiontech-inspired 0.145
ratingTypeSustainability 1.25e-11 ***
framingConditiontech-inspired:ratingTypeSustainability 0.527
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Correlation of Fixed Effects:
(Intr) frmnC- rtngTS
frmngCndtn- -0.681
rtngTypSstn -0.527 0.359
frmngCn-:TS 0.359 -0.527 -0.681dat_long %>%
group_by(framingCondition, ratingType) %>%
dplyr::summarise(
N = n(),
mean_DV = mean(ratingScore, na.rm = TRUE)
)`summarise()` has grouped output by 'framingCondition'. You can override using
the `.groups` argument.# A tibble: 4 × 4
# Groups: framingCondition [2]
framingCondition ratingType N mean_DV
<fct> <fct> <int> <dbl>
1 bio-inspired Bioinspiration 160 5.02
2 bio-inspired Sustainability 160 5.62
3 tech-inspired Bioinspiration 138 4.85
4 tech-inspired Sustainability 138 5.53ggplot(dat_long, aes(x = framingCondition, y = ratingScore, fill = ratingType)) +
scale_fill_manual(
values = c("Bioinspiration" = "#A67C49", "Sustainability" = "#55A868")
) +
stat_summary(fun = mean, geom = "bar", position = position_dodge(0.7), width = 0.6, color = "black") +
stat_summary(fun.data = mean_se, geom = "errorbar",
position = position_dodge(0.7), width = 0.15) +
labs(x = "Framing Condition", y = "Rating Score", fill = "Rating Type") +
theme_minimal()
ggplot(dat_long, aes(x = ratingType, y = ratingScore, fill = framingCondition)) +
scale_fill_manual(
values = c("tech-inspired" = "#A67C49", "bio-inspired" = "#55A868")
) +
stat_summary(fun = mean, geom = "bar", position = position_dodge(0.7), width = 0.6, color = "black") +
stat_summary(fun.data = mean_se, geom = "errorbar",
position = position_dodge(0.7), width = 0.15) +
labs(x = "Rating Type", y = "Rating Score", fill = "Framing Condition") +
theme_minimal()
# Estimated marginal means for each cell
emm <- emmeans(model_lm, ~ framingCondition * ratingType)
emm framingCondition ratingType emmean SE df lower.CL upper.CL
bio-inspired Bioinspiration 5.02 0.0812 592 4.86 5.18
tech-inspired Bioinspiration 4.85 0.0874 592 4.67 5.02
bio-inspired Sustainability 5.62 0.0812 592 5.46 5.78
tech-inspired Sustainability 5.53 0.0874 592 5.36 5.70
Confidence level used: 0.95 # Simple effects of ratingType within each level of framingCondition
simple_rating_by_frame <- contrast(
emm,
method = "pairwise",
by = "framingCondition",
adjust = "none" # or "bonferroni", "holm", etc. if you like
)
summary(simple_rating_by_frame)framingCondition = bio-inspired:
contrast estimate SE df t.ratio p.value
Bioinspiration - Sustainability -0.604 0.115 592 -5.258 <.0001
framingCondition = tech-inspired:
contrast estimate SE df t.ratio p.value
Bioinspiration - Sustainability -0.683 0.124 592 -5.527 <.0001# Simple effects of framingCondition within each level of ratingType
simple_frame_by_rating <- contrast(
emm,
method = "pairwise",
by = "ratingType",
adjust = "none"
)
summary(simple_frame_by_rating)ratingType = Bioinspiration:
contrast estimate SE df t.ratio p.value
(bio-inspired) - (tech-inspired) 0.1740 0.119 592 1.459 0.1450
ratingType = Sustainability:
contrast estimate SE df t.ratio p.value
(bio-inspired) - (tech-inspired) 0.0945 0.119 592 0.792 0.4287all_contrasts <- contrast(emm, method = "pairwise", adjust = "none")
summary(all_contrasts) contrast estimate SE
(bio-inspired Bioinspiration) - (tech-inspired Bioinspiration) 0.1740 0.119
(bio-inspired Bioinspiration) - (bio-inspired Sustainability) -0.6036 0.115
(bio-inspired Bioinspiration) - (tech-inspired Sustainability) -0.5091 0.119
(tech-inspired Bioinspiration) - (bio-inspired Sustainability) -0.7776 0.119
(tech-inspired Bioinspiration) - (tech-inspired Sustainability) -0.6831 0.124
(bio-inspired Sustainability) - (tech-inspired Sustainability) 0.0945 0.119
df t.ratio p.value
592 1.459 0.1450
592 -5.258 <.0001
592 -4.268 <.0001
592 -6.520 <.0001
592 -5.527 <.0001
592 0.792 0.4287plot(emm, comparisons = TRUE, by = "framingCondition")
plot(emm, comparisons = TRUE, by = "ratingType")
9 Heterogeneity
9.1 latent class analysis for mean items
manifest correlations:
psych::cor.plot(r = cor(dat[, str_detect(string = colnames(dat),
pattern = "^mean_")]
, use = "pairwise.complete.obs"),
upper = FALSE, xlas = 2, main = "Overall")
hist(dat$mean_Bioinspiration)
hist(dat$mean_Bioinspiration_PN)
hist(dat$mean_Bioinspiration_IPI)
hist(dat$mean_Bioinspiration_VRtN)
hist(dat$mean_Ecological)
length(unique(dat$ID))[1] 298length(unique(dat$PROLIFIC_PID))[1] 298setwd("outputs/LCA_means")
if(runMplusLCA){
LCA_dat <- dat[, c("ID", "mean_Ecological", "mean_Bioinspiration_PN", "mean_Bioinspiration_IPI", "mean_Bioinspiration_VRtN")]
tmp <- str_subset(string = colnames(LCA_dat), pattern = "^mean_")
tmp <- str_remove_all(string = tmp, pattern = "^mean_")
tmp <- str_remove_all(string = tmp, pattern = "inspiration|logical")
# cat(paste0(tmp, "(", 1:length(tmp), ")"))
# cat(paste0(tmp))
colnames(LCA_dat) <- c("ID", tmp)
# prepareMplusData(df = LCA_dat, filename = "LCA_dat.dat")
l = 1
list_lca_means <- list()
for(i in 2:LCArunsDef){
print(i)
numClasses <- i
LCA_mplus <- mplusObject(
TITLE = paste0("Latent Class Analysis Mean Scales", " c=", numClasses),
VARIABLE =paste0("
usevariables = Eco Bio_PN Bio_IPI Bio_VRtN;
classes = c(", numClasses, ")"),
ANALYSIS =
"
Type=mixture; ! LCA analysis
STARTS= 500 100;
!LRTstarts=0 0 300 20;
",
PLOT =
"
type = plot3;
series is Eco(1) Bio_PN(2) Bio_IPI(3) Bio_VRtN(4);
",
SAVEDATA = paste0("file = lca_", numClasses, ".txt ;
save = cprob;
format = free;
"),
OUTPUT = "tech11 tech14;", rdata = LCA_dat)
list_lca_means[[l]] <- mplusModeler(LCA_mplus,
modelout = paste0("lca_means", numClasses, ".inp"),
run = 1L)
l = l + 1
}
# comment out to avoid overwriting LCA outputs
saveRDS(list_lca_means, file="list_lca_means.rds")
}else{
list_lca_means <- readRDS("list_lca_means.rds" )
}getLCAfitstatistics(listMplusOutput = list_lca_means)
Classes LL AIC BIC SABIC CAIC BLRTp VLMRLRTp Entropy
1 2 -1769.348 3564.696 3612.759 3571.531 3625.758 0.00 0.0000 0.749
2 3 -1731.445 3498.890 3565.437 3508.353 3583.438 0.00 0.0155 0.766
3 4 -1706.929 3459.858 3544.892 3471.950 3567.891 0.00 0.2417 0.764
4 5 -1684.834 3425.668 3529.187 3440.389 3557.187 0.00 0.0316 0.783
5 6 -1666.555 3399.110 3521.114 3416.459 3554.114 0.00 0.1797 0.787
6 7 -1655.183 3386.367 3526.856 3406.344 3564.856 0.00 0.3161 0.798
7 8 -1644.944 3375.887 3534.862 3398.493 3577.863 0.02 0.2400 0.813### number of classes
num_classes <- 3 # index - 1
# Step 1: Extract means
params <- list_lca_means[[num_classes]]$results$parameters$unstandardized
means_df <- params %>%
filter(paramHeader == "Means" & !grepl("^C#\\d$", param))
# Step 2: Get class proportions
class_counts <- table(list_lca_means[[num_classes]]$results$savedata$C)
total_n <- sum(class_counts)
class_props <- round(100 * class_counts / total_n, 1)
# Create descriptive labels
class_labels <- paste0("Class ", names(class_counts), " (", class_props, "%)")
# Map class numbers to labels
class_label_map <- setNames(class_labels, paste0("Class ", names(class_counts)))
# Step 3: Prepare data for plotting
means_long <- means_df %>%
mutate(Indicator = param,
Class = paste0("Class ", LatentClass)) %>%
select(Indicator, Class, est) %>%
pivot_wider(names_from = Class, values_from = est) %>%
pivot_longer(cols = starts_with("Class"), names_to = "Class", values_to = "Mean")
# Apply the new labels
means_long$Class <- class_label_map[means_long$Class]
# Optional: Set indicator order
means_long$Indicator <- factor(means_long$Indicator)
# means_long$Indicator <- factor(means_long$Indicator,
# levels = c("Eco", "Bio_PN", "Bio_IPI", "Bio_VRtN"))
# Step 4: Plot
ggplot(means_long, aes(x = Indicator, y = Mean, group = Class, color = Class)) +
geom_line(size = 1) +
geom_point(size = 2) +
theme_minimal() +
labs(title = "Latent Class Profile Plot",
x = "Items",
y = "Estimated Means") +
theme(text = element_text(size = 14),
axis.text.x = element_text(angle = 45, hjust = 1),
legend.title = element_blank())Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
ℹ Please use `linewidth` instead.
class_counts
1 2 3 4
40 82 75 101 class_counts / nrow(dat)
1 2 3 4
0.1342282 0.2751678 0.2516779 0.3389262 we chose the 4 class solution as the best model
setwd("outputs/LCA_means")
dat_classes <- read.table(file = "lca_4_choosen.txt")
dat$lclasses_BioEco <- dat_classes$V99.2 check relation to framing condition
classes_tables <- table(dat$lclasses_BioEco, dat$framingCondition)
classes_tables
bio-inspired tech-inspired
1 14 26
2 32 50
3 58 17
4 56 45chi <- chisq.test(classes_tables, correct = FALSE)
chi_stat <- chi$statistic
chi
Pearson's Chi-squared test
data: classes_tables
X-squared = 29.7, df = 3, p-value = 1.596e-06# Cramer's V
n <- sum(classes_tables)
k <- min(nrow(classes_tables), ncol(classes_tables))
cramers_v <- sqrt(chi_stat / (n * (k - 1)))
cramers_vX-squared
0.3156982 # Extract standardized residuals
std_res <- chi$stdres
round(std_res, 2) # rounded for readability
bio-inspired tech-inspired
1 -2.55 2.55
2 -3.13 3.13
3 4.75 -4.75
4 0.43 -0.43# See which cells are "large" (e.g., |residual| > 2)
which(abs(std_res) > 2, arr.ind = TRUE) row col
1 1 1
2 2 1
3 3 1
1 1 2
2 2 2
3 3 2# A heatmap of standardized residuals with ggplot2
res_df <- as.data.frame(as.table(std_res))
colnames(res_df) <- c("lclasses_BioEco", "framingCondition", "stdres")
ggplot(res_df, aes(x = framingCondition,
y = lclasses_BioEco,
fill = stdres)) +
geom_tile() +
geom_text(aes(label = round(stdres, 2))) +
scale_fill_gradient2(
low = "blue",
mid = "white",
high = "red",
midpoint = 0
) +
labs(
title = "Standardized residuals: lclasses_BioEco × framingCondition",
x = "Framing condition",
y = "lclasses_BioEco",
fill = "Std. resid"
) +
theme_minimal()
9.3 check relation to mean scales
# ---- settings ----
class_var <- "lclasses_BioEco" # <-- change if your membership column is named differently
# Ensure class is a factor
dat[[class_var]] <- as.factor(dat[[class_var]])
# Grab all mean_* variables
mean_vars <- str_subset(colnames(dat), "^mean")
# Helper: eta^2 from one-way ANOVA (SS_between / SS_total)
eta_sq_oneway <- function(aov_obj) {
ss <- summary(aov_obj)[[1]][, "Sum Sq"]
names(ss) <- rownames(summary(aov_obj)[[1]])
ss_between <- ss[1] # first row = class factor
ss_total <- sum(ss, na.rm = TRUE) # between + residual
as.numeric(ss_between / ss_total)
}
# Run ANOVAs and build compact results table
anova_table <- lapply(mean_vars, function(dv) {
d <- dat %>% select(all_of(c(class_var, dv))) %>% tidyr::drop_na()
# Skip if DV has no variance or only 1 class present after NA drop
if (n_distinct(d[[dv]]) < 2 || n_distinct(d[[class_var]]) < 2) return(NULL)
fit <- aov(reformulate(class_var, response = dv), data = d)
sm <- summary(fit)[[1]]
tibble(
dv = dv,
n = nrow(d),
k = n_distinct(d[[class_var]]),
df1 = sm[1, "Df"],
df2 = sm[2, "Df"],
F = sm[1, "F value"],
p = sm[1, "Pr(>F)"],
eta_sq = eta_sq_oneway(fit)
)
}) %>% bind_rows() %>%
mutate(
p_adj = p.adjust(p, method = "BH") # optional multiple-testing control
) %>%
arrange(p)
anova_table# A tibble: 12 × 9
dv n k df1 df2 F p eta_sq p_adj
<chr> <int> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 mean_Bioinspiration 298 4 3 294 351. 8.22e-97 0.782 9.86e-96
2 mean_Bioinspiration_… 298 4 3 294 242. 4.31e-79 0.712 2.59e-78
3 mean_Bioinspiration_… 298 4 3 294 218. 2.19e-74 0.690 8.77e-74
4 mean_Bioinspiration_… 298 4 3 294 170. 5.76e-64 0.635 1.73e-63
5 mean_video_sitintDes… 298 4 3 294 24.5 3.74e-14 0.200 8.98e-14
6 mean_video_evalInf 298 4 3 294 22.3 4.94e-13 0.185 9.88e-13
7 mean_video_sitintTop… 298 4 3 294 21.7 9.95e-13 0.181 1.71e-12
8 mean_Ecological 298 4 3 294 20.4 5.20e-12 0.172 7.79e-12
9 mean_GAToRS_pp 298 4 3 294 14.9 4.82e- 9 0.132 6.43e- 9
10 mean_GAToRS_sp 298 4 3 294 8.09 3.39e- 5 0.0763 4.07e- 5
11 mean_GAToRS_pn 298 4 3 294 5.66 8.80e- 4 0.0546 9.60e- 4
12 mean_GAToRS_sn 298 4 3 294 3.84 1.01e- 2 0.0378 1.01e- 29.3.1 for video: Situational Interest Scale - Design
# --- ANOVA for Ecological Dimension - PN ---
aov_out <- aov_ez(
id = "PROLIFIC_PID", # replace with your participant ID column name
dv = "mean_video_sitintDesign",
data = dat,
between = "lclasses_BioEco"
)
print(aov_out)Anova Table (Type 3 tests)
Response: mean_video_sitintDesign
Effect df MSE F ges p.value
1 lclasses_BioEco 3, 294 1.12 24.45 *** .200 <.001
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '+' 0.1 ' ' 1# Post hoc (Tukey) for Ecological
em_eco <- emmeans(aov_out, "lclasses_BioEco")
eco_posthoc <- pairs(em_eco, adjust = "tukey")
print(eco_posthoc) contrast estimate SE df t.ratio p.value
lclasses_BioEco1 - lclasses_BioEco2 -0.7788 0.204 294 -3.814 0.0010
lclasses_BioEco1 - lclasses_BioEco3 -0.7503 0.207 294 -3.620 0.0020
lclasses_BioEco1 - lclasses_BioEco4 -1.5851 0.198 294 -8.015 <.0001
lclasses_BioEco2 - lclasses_BioEco3 0.0285 0.169 294 0.168 0.9983
lclasses_BioEco2 - lclasses_BioEco4 -0.8063 0.157 294 -5.124 <.0001
lclasses_BioEco3 - lclasses_BioEco4 -0.8348 0.161 294 -5.174 <.0001
P value adjustment: tukey method for comparing a family of 4 estimates # Summarize means and SE for plotting
plot_data <- data_summary(dat, "mean_video_sitintDesign", "lclasses_BioEco")
# --- Plot ---
ggplot(plot_data, aes(x = lclasses_BioEco, y = mean_video_sitintDesign)) +
geom_col(fill = "grey80", color = "black", width = 0.6) +
geom_errorbar(aes(ymin = mean_video_sitintDesign - se, ymax = mean_video_sitintDesign + se), width = 0.15) +
labs(x = "Class Assignment", y = "Mean Score") +
theme_apa() +
theme(
axis.title = element_text(face = "bold"),
legend.position = "none"
)
9.3.2 for mean_GAToRS_pp
# --- ANOVA for Ecological Dimension - PN ---
aov_out <- aov_ez(
id = "PROLIFIC_PID", # replace with your participant ID column name
dv = "mean_GAToRS_pp",
data = dat,
between = "lclasses_BioEco"
)
print(aov_out)Anova Table (Type 3 tests)
Response: mean_GAToRS_pp
Effect df MSE F ges p.value
1 lclasses_BioEco 3, 294 0.93 14.88 *** .132 <.001
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '+' 0.1 ' ' 1# Post hoc (Tukey) for Ecological
em_eco <- emmeans(aov_out, "lclasses_BioEco")
eco_posthoc <- pairs(em_eco, adjust = "tukey")
print(eco_posthoc) contrast estimate SE df t.ratio p.value
lclasses_BioEco1 - lclasses_BioEco2 -0.963 0.186 294 -5.186 <.0001
lclasses_BioEco1 - lclasses_BioEco3 -0.552 0.189 294 -2.926 0.0193
lclasses_BioEco1 - lclasses_BioEco4 -1.101 0.180 294 -6.119 <.0001
lclasses_BioEco2 - lclasses_BioEco3 0.411 0.154 294 2.674 0.0394
lclasses_BioEco2 - lclasses_BioEco4 -0.138 0.143 294 -0.963 0.7708
lclasses_BioEco3 - lclasses_BioEco4 -0.549 0.147 294 -3.742 0.0013
P value adjustment: tukey method for comparing a family of 4 estimates # Summarize means and SE for plotting
plot_data <- data_summary(dat, "mean_GAToRS_pp", "lclasses_BioEco")
# --- Plot ---
ggplot(plot_data, aes(x = lclasses_BioEco, y = mean_GAToRS_pp)) +
geom_col(fill = "grey80", color = "black", width = 0.6) +
geom_errorbar(aes(ymin = mean_GAToRS_pp - se, ymax = mean_GAToRS_pp + se), width = 0.15) +
labs(x = "Class Assignment", y = "Mean Score") +
theme_apa() +
theme(
axis.title = element_text(face = "bold"),
legend.position = "none"
)
10 Open Text Answers
get word count:
dat$word_count_ecological <- sapply(dat$reflection_ecological, function(x) {
length(strsplit(x, "\\s+")[[1]])
})
dat$word_count_social <- sapply(dat$reflection_social, function(x) {
length(strsplit(x, "\\s+")[[1]])
})
dat$word_count_economic <- sapply(dat$reflection_economic, function(x) {
length(strsplit(x, "\\s+")[[1]])
})
psych::describe(x = dat[, str_subset(string = colnames(dat), pattern = "^word_count")]) vars n mean sd median trimmed mad min max range
word_count_ecological 1 298 34.26 22.01 30 31.38 17.79 4 132 128
word_count_social 2 298 35.23 24.47 29 31.98 20.76 2 165 163
word_count_economic 3 298 35.68 24.22 30 32.10 19.27 3 136 133
skew kurtosis se
word_count_ecological 1.50 2.90 1.27
word_count_social 1.63 4.09 1.42
word_count_economic 1.66 3.33 1.40get sentiment:
# library(sentimentr)
sentiment_scores <- sentiment_by(dat$reflection_ecological)
dat$sentiment_ecological <- sentiment_scores$ave_sentiment
sentiment_scores <- sentiment_by(dat$reflection_social)
dat$sentiment_social <- sentiment_scores$ave_sentiment
sentiment_scores <- sentiment_by(dat$reflection_economic)
dat$sentiment_economic <- sentiment_scores$ave_sentiment
psych::describe(x = dat[, str_subset(string = colnames(dat), pattern = "^sentiment")]) vars n mean sd median trimmed mad min max range
sentiment_ecological 1 298 0.20 0.29 0.18 0.19 0.24 -0.62 1.27 1.88
sentiment_social 2 298 0.27 0.34 0.25 0.25 0.30 -1.03 1.56 2.59
sentiment_economic 3 298 0.33 0.30 0.31 0.32 0.27 -0.64 1.19 1.83
skew kurtosis se
sentiment_ecological 0.41 0.81 0.02
sentiment_social 0.61 2.08 0.02
sentiment_economic 0.17 0.52 0.0210.1 Correlations
psych::describe(x = dat[, str_subset(string = colnames(dat), pattern = "^word_count")]) vars n mean sd median trimmed mad min max range
word_count_ecological 1 298 34.26 22.01 30 31.38 17.79 4 132 128
word_count_social 2 298 35.23 24.47 29 31.98 20.76 2 165 163
word_count_economic 3 298 35.68 24.22 30 32.10 19.27 3 136 133
skew kurtosis se
word_count_ecological 1.50 2.90 1.27
word_count_social 1.63 4.09 1.42
word_count_economic 1.66 3.33 1.40# Select variables of interest
vars_for_corr <- dat[, c(
"mean_Bioinspiration",
"mean_Bioinspiration_PN",
"mean_Bioinspiration_IPI",
"mean_Bioinspiration_VRtN",
"mean_Ecological",
"word_count_ecological",
"word_count_social",
"word_count_economic",
"sentiment_ecological",
"sentiment_social",
"sentiment_economic"
)]
# Correlation matrix
cor_matrix <- cor(vars_for_corr, use = "pairwise.complete.obs")
psych::corPlot(r = cor_matrix)
10.2 SDGs
# run sdg detection
hits_ecological <- text2sdg::detect_sdg_systems(dat$reflection_ecological)Warning in transparent_trim(x, remember_spaces): Leading and trailing
whitespace has been trimmed for 70 items.Running Aurora
Running Elsevier
Running Auckland
Running SIRIS# create barplot
plot_sdg(hits_ecological, remove_duplicates = FALSE)
# create barplot with facets
plot_sdg(hits_ecological, remove_duplicates = FALSE) + ggplot2::facet_wrap(~system)
# run sdg detection
hits_social <- text2sdg::detect_sdg_systems(dat$reflection_social)Warning in transparent_trim(x, remember_spaces): Leading and trailing
whitespace has been trimmed for 72 items.Running Aurora
Running Elsevier
Running Auckland
Running SIRIS# create barplot
plot_sdg(hits_social, remove_duplicates = FALSE)
# create barplot with facets
plot_sdg(hits_social, remove_duplicates = FALSE) + ggplot2::facet_wrap(~system)
# run sdg detection
hits_economic <- text2sdg::detect_sdg_systems(dat$reflection_economic)Warning in transparent_trim(x, remember_spaces): Leading and trailing
whitespace has been trimmed for 74 items.Running Aurora
Running Elsevier
Running Auckland
Running SIRIS# create barplot
plot_sdg(hits_economic, remove_duplicates = FALSE)
# create barplot with facets
plot_sdg(hits_economic, remove_duplicates = FALSE) + ggplot2::facet_wrap(~system)
10.3 SDGs <-> framing, classes
# 1) Keep only SIRIS hits and join to participant-level data
hits_siris <- hits_ecological %>%
filter(system == "SIRIS") %>%
mutate(ID = as.integer(as.character(document))) # document is a factor in your tibble
dat_key <- dat %>%
select(ID, framingCondition, lclasses_BioEco) %>%
mutate(
ID = as.integer(ID),
framingCondition = factor(framingCondition),
lclasses_BioEco = factor(lclasses_BioEco)
)
hits_joined <- hits_siris %>%
left_join(dat_key, by = "ID")
# 2) Collapse to a binary "mentioned SDG" per participant (recommended for hypothesis tests)
sdg_bin <- hits_joined %>%
mutate(sdg = factor(sdg)) %>%
group_by(ID, framingCondition, lclasses_BioEco, sdg) %>%
dplyr::summarise(mentioned = 1L, .groups = "drop") %>%
tidyr::complete(ID, framingCondition, lclasses_BioEco, sdg, fill = list(mentioned = 0L))
# -------------------------
# Hypothesis tests
# -------------------------
# A) SDG distribution differs by framingCondition? (Chi-square on SDG x framing)
tab_frame <- sdg_bin %>%
group_by(sdg, framingCondition) %>%
dplyr::summarise(n = sum(mentioned), .groups = "drop") %>%
pivot_wider(names_from = framingCondition, values_from = n, values_fill = 0) %>%
tibble::column_to_rownames("sdg") %>%
as.matrix()
chi_frame <- chisq.test(tab_frame)Warning in chisq.test(tab_frame): Chi-Quadrat-Approximation kann inkorrekt seinchi_frame
Pearson's Chi-squared test
data: tab_frame
X-squared = 9.8478, df = 7, p-value = 0.1974# B) SDG distribution differs by latent class? (Chi-square on SDG x class)
tab_class <- sdg_bin %>%
group_by(sdg, lclasses_BioEco) %>%
dplyr::summarise(n = sum(mentioned), .groups = "drop") %>%
pivot_wider(names_from = lclasses_BioEco, values_from = n, values_fill = 0) %>%
tibble::column_to_rownames("sdg") %>%
as.matrix()
tab_class 1 2 3 4
SDG-07 2 4 1 8
SDG-08 1 1 4 2
SDG-09 0 0 1 0
SDG-11 0 0 1 1
SDG-12 1 5 3 6
SDG-13 1 3 6 3
SDG-14 0 0 0 1
SDG-15 1 2 1 3chi_class <- chisq.test(tab_class)Warning in chisq.test(tab_class): Chi-Quadrat-Approximation kann inkorrekt seinchi_class
Pearson's Chi-squared test
data: tab_class
X-squared = 15.36, df = 21, p-value = 0.8044# C) Joint test: SDG differs across framing *and* class (multinomial logistic regression)
# Outcome = SDG category; predictors = framingCondition + lclasses_BioEco (+ interaction)
library(nnet)
sdg_mentions <- sdg_bin %>%
filter(mentioned == 1) %>%
select(ID, sdg, framingCondition, lclasses_BioEco)
m0 <- multinom(sdg ~ 1, data = sdg_mentions, trace = FALSE)
m1 <- multinom(sdg ~ framingCondition + lclasses_BioEco, data = sdg_mentions, trace = FALSE)
m2 <- multinom(sdg ~ framingCondition * lclasses_BioEco, data = sdg_mentions, trace = FALSE)
anova(m0, m1, test = "Chisq") # overall main effects vs intercept-onlyLikelihood ratio tests of Multinomial Models
Response: sdg
Model Resid. df Resid. Dev Test Df LR stat.
1 1 427 219.3066
2 framingCondition + lclasses_BioEco 399 192.5429 1 vs 2 28 26.76364
Pr(Chi)
1
2 0.5311443anova(m1, m2, test = "Chisq") # adds interactionLikelihood ratio tests of Multinomial Models
Response: sdg
Model Resid. df Resid. Dev Test Df LR stat.
1 framingCondition + lclasses_BioEco 399 192.5429
2 framingCondition * lclasses_BioEco 378 176.0974 1 vs 2 21 16.44552
Pr(Chi)
1
2 0.7441201# Optional: which SDGs drive chi-square differences (standardized residuals)
round(chi_frame$stdres, 2) bio-inspired tech-inspired
SDG-07 -1.34 1.34
SDG-08 0.85 -0.85
SDG-09 -1.27 1.27
SDG-11 1.14 -1.14
SDG-12 -0.73 0.73
SDG-13 1.94 -1.94
SDG-14 -1.27 1.27
SDG-15 -0.24 0.24round(chi_class$stdres, 2) 1 2 3 4
SDG-07 0.55 0.26 -2.07 1.34
SDG-08 0.29 -0.83 1.53 -0.85
SDG-09 -0.33 -0.57 1.64 -0.80
SDG-11 -0.47 -0.81 0.73 0.33
SDG-12 -0.45 0.95 -0.74 0.12
SDG-13 -0.27 -0.11 1.70 -1.30
SDG-14 -0.33 -0.57 -0.62 1.27
SDG-15 0.44 0.29 -0.83 0.24