library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(ggplot2)
## Warning: package 'ggplot2' was built under R version 3.6.3
library(sjPlot)
## Warning: package 'sjPlot' was built under R version 3.6.3
## Learn more about sjPlot with 'browseVignettes("sjPlot")'.
library(psych)
## Warning: package 'psych' was built under R version 3.6.3
##
## Attaching package: 'psych'
## The following objects are masked from 'package:ggplot2':
##
## %+%, alpha
folder <- "E:/Analyse_Corona_Einkaufen/Exporte/upload/data_purchasing_under_threat.csv" #define path
data_sample <- read.table(folder,
header = TRUE,
sep = ","
)
#data_sample$sem_diff <- as.numeric(as.character(data_sample$sem_diff))
data_sample$householdsize <- as.numeric(as.character(data_sample$householdsize))
#Functions
preprocess_overall_pruchasing <- function(df){
continuous_vars <- select(df,
FreqMarch,
QuaMarch,
age,
education,
householdsize,
SEA,
sem_diff,
IUS,
STAI,
info_verlauf,
Prob_Einkaufen)
df_export <- data.frame(select(df, ID, sex, risk_self, risk_loved),
apply(continuous_vars, 2, scale))
return(df_export)
}
preprocess_overall_pruchasing_filtered <- function(df){
group_fre <- c()
group_fre[df$FreqMarch < 0] <- "less"
group_fre[df$FreqMarch == 0] <- "same"
group_fre[df$FreqMarch > 0] <- "more"
group_qua <- c()
group_qua[df$QuaMarch < 0] <- "less"
group_qua[df$QuaMarch == 0] <- "same"
group_qua[df$QuaMarch > 0] <- "more"
filtered_df <- filter(df, group_qua != "less" & group_fre != "more")
continuous_vars <- select(filtered_df,
FreqMarch,
QuaMarch,
age,
education,
householdsize,
SEA,
sem_diff,
IUS,
STAI,
info_verlauf,
Prob_Einkaufen)
df_export <- data.frame(select(filtered_df, ID, sex, risk_self, risk_loved),
apply(continuous_vars, 2, scale))
return(df_export)
}
preprocess_individual_products <- function(df, t, DV){
df$Konserven_March[df$Konserven_March < 0] <- t
df$Seife_March[df$Seife_March < 0] <- t
df$Toilettenpapier_March[df$Toilettenpapier_March < 0] <- t
df$Nudeln_Reis_March[df$Nudeln_Reis_March < 0] <- t
df$Hefe_March[df$Hefe_March < 0] <- t
df$frisch_March[df$frisch_March < 0] <- t
df$Desinfektion_March[df$Desinfektion_March < 0] <- t
NonPerishableFood <- rowMeans(select(df, Desinfektion_March,
Seife_March,
Toilettenpapier_March), na.rm = TRUE)
HygieneProducts <- rowMeans(select(df, Nudeln_Reis_March,
Konserven_March,
Toilettenpapier_March), na.rm = TRUE)
FreshFood <- df$frisch_March
df_new <- data.frame(select(df, ID:Prob_Einkaufen, info_verlauf),
NonPerishableFood,
HygieneProducts,
FreshFood)
continuous_vars <- select(df_new,
all_of(DV),
age,
education,
householdsize,
SEA,
sem_diff,
IUS,
STAI,
info_verlauf,
Prob_Einkaufen)
df_export <- data.frame(select(df_new, ID, sex, risk_self, risk_loved),
apply(continuous_vars, 2, scale))
return(na.omit(df_export))
}
print_model <- function(df, model, add_variable){
if(model == "Baseline"){
subdata_Freq <- select(df, FreqMarch, sex, age, education, householdsize, SEA)
subdata_Qua <- select(df, QuaMarch, sex, age, education, householdsize, SEA)
Model_Freq <- lm(FreqMarch ~ ., data = subdata_Freq)
Model_Qua <- lm(QuaMarch ~ ., data = subdata_Qua)
table_model <- tab_model(Model_Freq, Model_Qua,
show.intercept = FALSE,
show.ci = FALSE,
show.se = FALSE,
show.stat = TRUE,
#show.df = TRUE,
#p.style = "scientific",
#string.se = "SE",
string.est = "b")
return(table_model)
}
else if(model == "specific"){
subdata_Freq <- select(df, FreqMarch, sex, age, education, householdsize, SEA, add_variable)
subdata_Qua <- select(df, QuaMarch, sex, age, education, householdsize, SEA, add_variable)
Model_Freq <- lm(FreqMarch ~ ., data = subdata_Freq)
Model_Qua <- lm(QuaMarch ~ ., data = subdata_Qua)
table_model <- tab_model(Model_Freq, Model_Qua,
show.intercept = FALSE,
show.ci = FALSE,
show.se = FALSE,
show.stat = TRUE,
#show.df = TRUE,
#p.style = "scientific",
#string.se = "SE",
string.est = "b")
return(table_model)
}
else if(model == "overall"){
subdata_Freq <-select(df, FreqMarch,
sex,
age,
education,
householdsize,
SEA,
sem_diff,
#risk_self,
#risk_loved,
IUS,
STAI,
info_verlauf,
Prob_Einkaufen)
subdata_Qua <-select(df, QuaMarch,
sex,
age,
education,
householdsize,
SEA,
sem_diff,
#risk_self,
#risk_loved,
IUS,
STAI,
info_verlauf,
Prob_Einkaufen)
Model_Freq <- lm(FreqMarch ~ ., data = subdata_Freq)
Model_Qua <- lm(QuaMarch ~ ., data = subdata_Qua)
table_model <- tab_model(Model_Freq, Model_Qua,
show.intercept = FALSE,
show.ci = FALSE,
show.se = FALSE,
show.stat = TRUE,
#show.df = TRUE,
#p.style = "scientific",
#string.se = "SE",
string.est = "b")
return(table_model)
}
else{"Something went wrong!"}
}
#Descriptives
describe(data_sample)
## vars n mean sd median trimmed mad min
## X 1 813 407.00 234.84 407.00 407.00 300.97 1
## ID 2 813 1437.23 734.81 1341.00 1402.01 929.59 348
## sex 3 813 0.22 0.41 0.00 0.14 0.00 0
## age 4 813 42.42 15.00 42.00 42.02 19.27 18
## education 5 813 4.08 0.91 4.00 4.16 1.48 1
## householdsize 6 813 2.40 1.56 2.00 2.21 1.48 1
## risk_self 7 813 0.41 0.49 0.00 0.39 0.00 0
## risk_loved 8 813 0.50 0.50 1.00 0.50 0.00 0
## SEA 9 813 19.86 2.33 20.00 19.88 2.97 13
## IUS 10 813 32.50 9.92 32.00 32.24 10.38 12
## STAI 11 813 40.31 11.13 39.00 39.69 11.86 20
## sem_diff 12 813 4.16 1.36 4.17 4.18 1.48 1
## Prob_Einkaufen 13 813 25.68 25.57 18.00 22.05 23.72 0
## FreqMarch 14 813 -0.86 1.35 -1.00 -0.91 1.48 -3
## QuaMarch 15 813 0.58 1.12 0.00 0.55 1.48 -3
## info_verlauf 16 813 3.20 0.72 3.00 3.26 1.48 1
## Konserven_March 17 666 0.39 0.95 0.00 0.33 0.00 -3
## Seife_March 18 787 0.26 0.84 0.00 0.18 0.00 -3
## Toilettenpapier_March 19 803 -0.02 1.02 0.00 0.07 0.00 -3
## Nudeln_Reis_March 20 797 0.31 0.95 0.00 0.29 0.00 -3
## Hefe_March 21 462 -0.38 1.27 0.00 -0.29 0.00 -3
## frisch_March 22 794 0.18 0.70 0.00 0.11 0.00 -3
## Desinfektion_March 23 489 0.42 1.25 0.00 0.46 1.48 -3
## diff_sorge 24 812 4.29 1.85 5.00 4.36 1.48 1
## diff_angst 25 808 3.49 1.84 4.00 3.40 2.97 1
## diff_denke 26 808 4.53 1.53 5.00 4.60 1.48 1
## diff_hilflos 27 811 3.98 1.82 4.00 3.97 1.48 1
## diff_belastend 28 812 4.50 1.90 5.00 4.63 1.48 1
## diff_nah 29 809 4.16 1.64 4.00 4.22 1.48 1
## STAI1 30 813 2.88 0.72 3.00 2.87 0.00 1
## STAI2 31 813 2.29 0.82 2.00 2.26 1.48 1
## STAI3 32 813 1.74 0.73 2.00 1.66 1.48 1
## STAI4 33 813 1.47 0.72 1.00 1.33 0.00 1
## STAI5 34 813 1.86 0.75 2.00 1.80 1.48 1
## STAI6 35 813 2.52 0.83 3.00 2.53 1.48 1
## STAI7 36 813 2.78 0.82 3.00 2.79 1.48 1
## STAI8 37 813 1.77 0.77 2.00 1.68 1.48 1
## STAI9 38 813 2.25 0.93 2.00 2.19 1.48 1
## STAI10 39 813 2.95 0.81 3.00 2.98 1.48 1
## STAI11 40 813 1.92 0.88 2.00 1.84 1.48 1
## STAI12 41 813 1.99 0.89 2.00 1.89 1.48 1
## STAI13 42 813 2.82 0.93 3.00 2.88 1.48 1
## STAI14 43 813 1.92 0.82 2.00 1.85 1.48 1
## STAI15 44 813 1.81 0.77 2.00 1.73 1.48 1
## STAI16 45 813 3.08 0.82 3.00 3.14 1.48 1
## STAI17 46 813 2.07 0.86 2.00 2.00 1.48 1
## STAI18 47 813 2.06 0.92 2.00 1.97 1.48 1
## STAI19 48 813 2.82 0.85 3.00 2.84 1.48 1
## STAI20 49 813 2.00 0.90 2.00 1.91 1.48 1
## IUS1 50 813 2.77 1.24 3.00 2.71 1.48 1
## IUS2 51 813 3.39 1.29 3.00 3.49 1.48 1
## IUS3 52 813 2.66 1.37 3.00 2.57 1.48 1
## IUS4 53 813 3.18 1.25 3.00 3.23 1.48 1
## IUS5 54 813 2.66 1.31 3.00 2.57 1.48 1
## IUS6 55 813 2.30 1.27 2.00 2.14 1.48 1
## IUS7 56 813 2.67 1.28 3.00 2.59 1.48 1
## IUS8 57 813 2.86 1.36 3.00 2.83 1.48 1
## IUS9 58 813 2.31 1.26 2.00 2.15 1.48 1
## IUS10 59 813 2.22 1.22 2.00 2.06 1.48 1
## IUS11 60 813 3.10 1.29 3.00 3.13 1.48 1
## IUS12 61 813 2.38 1.24 2.00 2.24 1.48 1
## max range skew kurtosis se
## X 813 812 0.00 -1.20 8.24
## ID 2858 2510 0.30 -1.13 25.77
## sex 1 1 1.38 -0.09 0.01
## age 79 61 0.13 -1.20 0.53
## education 5 4 -0.62 -0.47 0.03
## householdsize 20 19 4.44 41.44 0.05
## risk_self 1 1 0.36 -1.88 0.02
## risk_loved 1 1 -0.01 -2.00 0.02
## SEA 27 14 -0.07 0.03 0.08
## IUS 60 48 0.24 -0.40 0.35
## STAI 72 52 0.44 -0.43 0.39
## sem_diff 7 6 -0.14 -0.50 0.05
## Prob_Einkaufen 100 100 1.03 0.22 0.90
## FreqMarch 3 6 0.29 0.00 0.05
## QuaMarch 3 6 0.11 0.84 0.04
## info_verlauf 4 3 -0.44 -0.58 0.03
## Konserven_March 3 6 0.23 2.52 0.04
## Seife_March 3 6 0.30 4.05 0.03
## Toilettenpapier_March 3 6 -0.70 2.97 0.04
## Nudeln_Reis_March 3 6 0.01 2.64 0.03
## Hefe_March 3 6 -0.65 0.63 0.06
## frisch_March 3 6 1.02 5.39 0.02
## Desinfektion_March 3 6 -0.37 1.26 0.06
## diff_sorge 7 6 -0.36 -0.95 0.06
## diff_angst 7 6 0.21 -1.04 0.06
## diff_denke 7 6 -0.42 -0.33 0.05
## diff_hilflos 7 6 0.02 -0.96 0.06
## diff_belastend 7 6 -0.43 -0.91 0.07
## diff_nah 7 6 -0.28 -0.61 0.06
## STAI1 4 3 -0.06 -0.55 0.03
## STAI2 4 3 0.30 -0.37 0.03
## STAI3 4 3 0.70 0.03 0.03
## STAI4 4 3 1.49 1.75 0.03
## STAI5 4 3 0.53 -0.21 0.03
## STAI6 4 3 -0.11 -0.54 0.03
## STAI7 4 3 -0.13 -0.62 0.03
## STAI8 4 3 0.78 0.15 0.03
## STAI9 4 3 0.32 -0.74 0.03
## STAI10 4 3 -0.30 -0.58 0.03
## STAI11 4 3 0.64 -0.41 0.03
## STAI12 4 3 0.69 -0.20 0.03
## STAI13 4 3 -0.29 -0.83 0.03
## STAI14 4 3 0.60 -0.20 0.03
## STAI15 4 3 0.72 0.15 0.03
## STAI16 4 3 -0.48 -0.57 0.03
## STAI17 4 3 0.52 -0.32 0.03
## STAI18 4 3 0.53 -0.57 0.03
## STAI19 4 3 -0.15 -0.78 0.03
## STAI20 4 3 0.54 -0.56 0.03
## IUS1 5 4 0.18 -0.77 0.04
## IUS2 5 4 -0.37 -0.78 0.05
## IUS3 5 4 0.29 -1.07 0.05
## IUS4 5 4 -0.14 -0.75 0.04
## IUS5 5 4 0.30 -0.90 0.05
## IUS6 5 4 0.64 -0.59 0.04
## IUS7 5 4 0.25 -0.88 0.04
## IUS8 5 4 0.10 -1.08 0.05
## IUS9 5 4 0.62 -0.55 0.04
## IUS10 5 4 0.71 -0.38 0.04
## IUS11 5 4 -0.10 -0.91 0.05
## IUS12 5 4 0.52 -0.56 0.04
#Threat of COVID-19 (sem_diff)
df_sem_diff <- select(data_sample, diff_sorge:diff_nah)
#STAI
data_sample$STAI1_rec <- as.numeric(recode(as.character(data_sample$STAI1), "1" = "4", "2" = "3", "3" = "2", "4" = "1", ))
data_sample$STAI6_rec <- as.numeric(recode(as.character(data_sample$STAI6), "1" = "4", "2" = "3", "3" = "2", "4" = "1", ))
data_sample$STAI7_rec <- as.numeric(recode(as.character(data_sample$STAI7), "1" = "4", "2" = "3", "3" = "2", "4" = "1", ))
data_sample$STAI10_rec <- as.numeric(recode(as.character(data_sample$STAI10), "1" = "4", "2" = "3", "3" = "2", "4" = "1", ))
data_sample$STAI13_rec <- as.numeric(recode(as.character(data_sample$STAI13), "1" = "4", "2" = "3", "3" = "2", "4" = "1", ))
data_sample$STAI16_rec <- as.numeric(recode(as.character(data_sample$STAI16), "1" = "4", "2" = "3", "3" = "2", "4" = "1", ))
data_sample$STAI19_rec <- as.numeric(recode(as.character(data_sample$STAI19), "1" = "4", "2" = "3", "3" = "2", "4" = "1", ))
df_STAI <- select(data_sample,
STAI1_rec,
STAI2,
STAI3,
STAI4,
STAI5,
STAI6_rec,
STAI7_rec,
STAI8,
STAI9,
STAI10_rec,
STAI11,
STAI12,
STAI13_rec,
STAI14,
STAI15,
STAI16_rec,
STAI17,
STAI18,
STAI19_rec,
STAI20)
#IUS
df_IUS <- select(data_sample, IUS1:IUS12)
#Cronbach´s Alpha
psych::alpha(df_sem_diff)
##
## Reliability analysis
## Call: psych::alpha(x = df_sem_diff)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.86 0.86 0.85 0.51 6.2 0.0074 4.2 1.4 0.52
##
## lower alpha upper 95% confidence boundaries
## 0.85 0.86 0.88
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r
## diff_sorge 0.82 0.82 0.79 0.47 4.5 0.0100 0.0074
## diff_angst 0.82 0.82 0.79 0.47 4.4 0.0101 0.0067
## diff_denke 0.85 0.85 0.83 0.53 5.5 0.0084 0.0133
## diff_hilflos 0.84 0.84 0.83 0.52 5.4 0.0085 0.0113
## diff_belastend 0.84 0.84 0.82 0.51 5.2 0.0086 0.0146
## diff_nah 0.86 0.86 0.84 0.54 5.9 0.0079 0.0082
## med.r
## diff_sorge 0.50
## diff_angst 0.52
## diff_denke 0.53
## diff_hilflos 0.52
## diff_belastend 0.51
## diff_nah 0.52
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## diff_sorge 812 0.85 0.84 0.83 0.76 4.3 1.8
## diff_angst 808 0.85 0.85 0.84 0.77 3.5 1.8
## diff_denke 808 0.71 0.73 0.64 0.60 4.5 1.5
## diff_hilflos 811 0.75 0.74 0.66 0.62 4.0 1.8
## diff_belastend 812 0.77 0.76 0.69 0.64 4.5 1.9
## diff_nah 809 0.68 0.69 0.59 0.55 4.2 1.6
##
## Non missing response frequency for each item
## 1 2 3 4 5 6 7 miss
## diff_sorge 0.11 0.11 0.10 0.14 0.25 0.18 0.11 0.00
## diff_angst 0.19 0.18 0.13 0.18 0.18 0.08 0.07 0.01
## diff_denke 0.04 0.07 0.12 0.23 0.26 0.19 0.09 0.01
## diff_hilflos 0.11 0.13 0.16 0.22 0.15 0.12 0.11 0.00
## diff_belastend 0.10 0.10 0.07 0.14 0.25 0.16 0.18 0.00
## diff_nah 0.09 0.09 0.12 0.26 0.23 0.14 0.07 0.00
psych::alpha(df_STAI)
##
## Reliability analysis
## Call: psych::alpha(x = df_STAI)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.94 0.94 0.95 0.42 15 0.0033 2 0.56 0.42
##
## lower alpha upper 95% confidence boundaries
## 0.93 0.94 0.94
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## STAI1_rec 0.93 0.93 0.94 0.43 14 0.0034 0.0110 0.42
## STAI2 0.93 0.94 0.95 0.43 14 0.0033 0.0112 0.43
## STAI3 0.93 0.93 0.94 0.42 14 0.0034 0.0114 0.42
## STAI4 0.93 0.93 0.94 0.43 14 0.0034 0.0114 0.42
## STAI5 0.94 0.94 0.95 0.44 15 0.0033 0.0104 0.43
## STAI6_rec 0.93 0.93 0.94 0.43 14 0.0034 0.0110 0.42
## STAI7_rec 0.93 0.93 0.94 0.43 14 0.0034 0.0113 0.42
## STAI8 0.93 0.93 0.94 0.42 14 0.0035 0.0114 0.41
## STAI9 0.93 0.93 0.94 0.43 14 0.0033 0.0105 0.42
## STAI10_rec 0.93 0.93 0.94 0.42 14 0.0035 0.0098 0.41
## STAI11 0.93 0.93 0.94 0.42 14 0.0035 0.0112 0.41
## STAI12 0.93 0.93 0.94 0.43 14 0.0034 0.0118 0.42
## STAI13_rec 0.93 0.93 0.94 0.43 14 0.0034 0.0103 0.42
## STAI14 0.93 0.93 0.94 0.43 14 0.0034 0.0108 0.42
## STAI15 0.93 0.93 0.94 0.42 14 0.0035 0.0109 0.41
## STAI16_rec 0.93 0.93 0.94 0.42 14 0.0035 0.0098 0.41
## STAI17 0.93 0.93 0.94 0.42 14 0.0034 0.0109 0.42
## STAI18 0.93 0.93 0.94 0.43 14 0.0034 0.0117 0.42
## STAI19_rec 0.93 0.93 0.94 0.42 14 0.0035 0.0103 0.41
## STAI20 0.93 0.93 0.94 0.42 14 0.0035 0.0117 0.41
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## STAI1_rec 813 0.64 0.65 0.63 0.60 2.1 0.72
## STAI2 813 0.58 0.58 0.55 0.53 2.3 0.82
## STAI3 813 0.66 0.67 0.65 0.62 1.7 0.73
## STAI4 813 0.64 0.65 0.62 0.60 1.5 0.72
## STAI5 813 0.53 0.53 0.49 0.48 1.9 0.75
## STAI6_rec 813 0.64 0.64 0.62 0.59 2.5 0.83
## STAI7_rec 813 0.65 0.65 0.62 0.60 2.2 0.82
## STAI8 813 0.73 0.73 0.72 0.70 1.8 0.77
## STAI9 813 0.62 0.61 0.60 0.57 2.3 0.93
## STAI10_rec 813 0.72 0.72 0.72 0.68 2.1 0.81
## STAI11 813 0.77 0.76 0.75 0.73 1.9 0.88
## STAI12 813 0.66 0.65 0.63 0.61 2.0 0.89
## STAI13_rec 813 0.64 0.64 0.62 0.59 2.2 0.93
## STAI14 813 0.61 0.61 0.58 0.56 1.9 0.82
## STAI15 813 0.77 0.78 0.77 0.74 1.8 0.77
## STAI16_rec 813 0.77 0.77 0.77 0.74 1.9 0.82
## STAI17 813 0.68 0.67 0.66 0.63 2.1 0.86
## STAI18 813 0.66 0.66 0.63 0.61 2.1 0.92
## STAI19_rec 813 0.78 0.78 0.78 0.75 2.2 0.85
## STAI20 813 0.71 0.70 0.68 0.66 2.0 0.90
##
## Non missing response frequency for each item
## 1 2 3 4 miss
## STAI1_rec 0.19 0.51 0.28 0.01 0
## STAI2 0.15 0.49 0.28 0.08 0
## STAI3 0.41 0.45 0.12 0.02 0
## STAI4 0.64 0.27 0.07 0.02 0
## STAI5 0.34 0.47 0.16 0.02 0
## STAI6_rec 0.10 0.43 0.36 0.11 0
## STAI7_rec 0.20 0.44 0.32 0.05 0
## STAI8 0.41 0.44 0.13 0.03 0
## STAI9 0.22 0.41 0.25 0.11 0
## STAI10_rec 0.26 0.45 0.25 0.03 0
## STAI11 0.37 0.39 0.18 0.06 0
## STAI12 0.32 0.45 0.15 0.08 0
## STAI13_rec 0.27 0.37 0.27 0.09 0
## STAI14 0.33 0.45 0.17 0.04 0
## STAI15 0.38 0.46 0.13 0.03 0
## STAI16_rec 0.35 0.41 0.21 0.03 0
## STAI17 0.27 0.47 0.20 0.07 0
## STAI18 0.31 0.40 0.20 0.08 0
## STAI19_rec 0.24 0.40 0.31 0.05 0
## STAI20 0.34 0.39 0.21 0.07 0
psych::alpha(df_IUS)
##
## Reliability analysis
## Call: psych::alpha(x = df_IUS)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.87 0.87 0.88 0.36 6.8 0.0066 2.7 0.83 0.36
##
## lower alpha upper 95% confidence boundaries
## 0.86 0.87 0.89
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## IUS1 0.86 0.86 0.87 0.36 6.2 0.0073 0.0107 0.35
## IUS2 0.87 0.87 0.88 0.38 6.8 0.0067 0.0096 0.40
## IUS3 0.86 0.86 0.86 0.35 6.0 0.0075 0.0099 0.35
## IUS4 0.87 0.87 0.87 0.38 6.6 0.0068 0.0092 0.38
## IUS5 0.86 0.86 0.87 0.36 6.2 0.0072 0.0119 0.35
## IUS6 0.86 0.86 0.86 0.36 6.2 0.0073 0.0087 0.35
## IUS7 0.86 0.86 0.87 0.37 6.4 0.0071 0.0088 0.36
## IUS8 0.86 0.86 0.87 0.36 6.2 0.0073 0.0116 0.36
## IUS9 0.86 0.86 0.87 0.36 6.3 0.0072 0.0117 0.36
## IUS10 0.86 0.86 0.87 0.36 6.1 0.0073 0.0101 0.35
## IUS11 0.86 0.86 0.87 0.37 6.3 0.0071 0.0106 0.36
## IUS12 0.86 0.86 0.86 0.35 6.0 0.0075 0.0107 0.33
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## IUS1 813 0.67 0.67 0.63 0.59 2.8 1.2
## IUS2 813 0.50 0.50 0.42 0.40 3.4 1.3
## IUS3 813 0.72 0.71 0.69 0.64 2.7 1.4
## IUS4 813 0.54 0.55 0.49 0.45 3.2 1.2
## IUS5 813 0.66 0.66 0.61 0.58 2.7 1.3
## IUS6 813 0.67 0.67 0.65 0.59 2.3 1.3
## IUS7 813 0.62 0.62 0.58 0.53 2.7 1.3
## IUS8 813 0.67 0.67 0.63 0.59 2.9 1.4
## IUS9 813 0.65 0.65 0.60 0.56 2.3 1.3
## IUS10 813 0.68 0.68 0.65 0.60 2.2 1.2
## IUS11 813 0.63 0.63 0.59 0.54 3.1 1.3
## IUS12 813 0.72 0.73 0.70 0.66 2.4 1.2
##
## Non missing response frequency for each item
## 1 2 3 4 5 miss
## IUS1 0.21 0.18 0.38 0.12 0.12 0
## IUS2 0.12 0.08 0.34 0.20 0.26 0
## IUS3 0.29 0.16 0.29 0.11 0.14 0
## IUS4 0.13 0.11 0.40 0.16 0.20 0
## IUS5 0.26 0.18 0.33 0.10 0.13 0
## IUS6 0.37 0.20 0.27 0.07 0.08 0
## IUS7 0.25 0.17 0.34 0.12 0.11 0
## IUS8 0.23 0.15 0.32 0.14 0.16 0
## IUS9 0.37 0.19 0.30 0.06 0.09 0
## IUS10 0.38 0.21 0.27 0.06 0.07 0
## IUS11 0.16 0.13 0.37 0.16 0.19 0
## IUS12 0.34 0.17 0.35 0.05 0.09 0
#Preprocessing
data <- preprocess_overall_pruchasing(df = data_sample) #full range scale data
filtered_data <- preprocess_overall_pruchasing_filtered(df = data_sample)
data_food <- preprocess_individual_products(df = data_sample, t = NA, DV = "NonPerishableFood")
data_hygiene <- preprocess_individual_products(df = data_sample, t = NA, DV = "HygieneProducts")
data_freshFood <- preprocess_individual_products(df = data_sample, t = NA, DV = "FreshFood")
#correlations full range scale
cor_data <- tab_corr(data = select(data,
FreqMarch,
QuaMarch,
sex,
age,
education,
householdsize,
SEA,
sem_diff,
Prob_Einkaufen,
IUS,
STAI,
info_verlauf,
risk_self,
risk_loved), triangle = "lower")
cor_data
|
Â
|
FreqMarch
|
QuaMarch
|
sex
|
age
|
education
|
householdsize
|
SEA
|
sem_diff
|
Prob_Einkaufen
|
IUS
|
STAI
|
info_verlauf
|
risk_self
|
risk_loved
|
|
FreqMarch
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
|
QuaMarch
|
-0.309***
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
|
sex
|
0.107**
|
-0.035
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
|
age
|
-0.037
|
-0.121***
|
-0.045
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
|
education
|
-0.058
|
0.095**
|
0.002
|
-0.099**
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
|
householdsize
|
-0.002
|
0.022
|
-0.047
|
-0.097**
|
0.039
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
|
SEA
|
-0.014
|
-0.081*
|
-0.113**
|
0.179***
|
0.001
|
-0.016
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
|
sem_diff
|
-0.184***
|
0.226***
|
-0.150***
|
-0.110**
|
0.116***
|
0.024
|
-0.083*
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
|
Prob_Einkaufen
|
-0.122***
|
0.141***
|
-0.036
|
-0.083*
|
-0.026
|
-0.038
|
-0.088*
|
0.343***
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
|
IUS
|
0.018
|
0.149***
|
-0.033
|
-0.179***
|
-0.033
|
-0.026
|
-0.136***
|
0.300***
|
0.237***
|
Â
|
Â
|
Â
|
Â
|
Â
|
|
STAI
|
-0.021
|
0.109**
|
-0.043
|
-0.231***
|
-0.048
|
-0.006
|
-0.224***
|
0.325***
|
0.232***
|
0.605***
|
Â
|
Â
|
Â
|
Â
|
|
info_verlauf
|
-0.060
|
0.087*
|
-0.006
|
0.269***
|
-0.025
|
0.039
|
0.092**
|
0.241***
|
0.033
|
0.067
|
-0.059
|
Â
|
Â
|
Â
|
|
risk_self
|
-0.059
|
-0.094**
|
-0.001
|
0.438***
|
-0.119***
|
-0.134***
|
0.010
|
0.048
|
0.106**
|
-0.042
|
0.011
|
0.090*
|
Â
|
Â
|
|
risk_loved
|
-0.064
|
-0.004
|
-0.078*
|
0.152***
|
-0.033
|
-0.017
|
-0.039
|
0.042
|
0.008
|
-0.022
|
0.019
|
0.024
|
0.372***
|
Â
|
|
Computed correlation used pearson-method with listwise-deletion.
|
#correlations
cor_data_filtered <- tab_corr(data = select(filtered_data,
FreqMarch,
QuaMarch,
sex,
age,
education,
householdsize,
SEA,
sem_diff,
Prob_Einkaufen,
IUS,
STAI,
info_verlauf,
risk_self,
risk_loved), triangle = "lower")
cor_data_filtered
|
Â
|
FreqMarch
|
QuaMarch
|
sex
|
age
|
education
|
householdsize
|
SEA
|
sem_diff
|
Prob_Einkaufen
|
IUS
|
STAI
|
info_verlauf
|
risk_self
|
risk_loved
|
|
FreqMarch
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
|
QuaMarch
|
-0.607***
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
|
sex
|
0.129***
|
-0.068
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
|
age
|
-0.033
|
-0.108**
|
-0.051
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
|
education
|
-0.127***
|
0.122**
|
0.017
|
-0.103**
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
|
householdsize
|
-0.018
|
0.038
|
-0.026
|
-0.077*
|
0.035
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
|
SEA
|
0.007
|
-0.049
|
-0.111**
|
0.159***
|
-0.011
|
-0.013
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
|
sem_diff
|
-0.319***
|
0.314***
|
-0.156***
|
-0.104**
|
0.086*
|
0.017
|
-0.095*
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
|
Prob_Einkaufen
|
-0.189***
|
0.203***
|
-0.048
|
-0.068
|
-0.018
|
0.001
|
-0.068
|
0.358***
|
Â
|
Â
|
Â
|
Â
|
Â
|
Â
|
|
IUS
|
-0.074
|
0.121**
|
-0.051
|
-0.188***
|
-0.038
|
-0.028
|
-0.133***
|
0.322***
|
0.208***
|
Â
|
Â
|
Â
|
Â
|
Â
|
|
STAI
|
-0.082*
|
0.111**
|
-0.043
|
-0.230***
|
-0.080*
|
-0.036
|
-0.223***
|
0.306***
|
0.218***
|
0.600***
|
Â
|
Â
|
Â
|
Â
|
|
info_verlauf
|
-0.174***
|
0.146***
|
-0.007
|
0.273***
|
-0.015
|
0.031
|
0.106**
|
0.238***
|
0.025
|
0.063
|
-0.088*
|
Â
|
Â
|
Â
|
|
risk_self
|
-0.066
|
-0.047
|
0.006
|
0.464***
|
-0.119**
|
-0.125**
|
0.013
|
0.032
|
0.087*
|
-0.063
|
-0.009
|
0.105**
|
Â
|
Â
|
|
risk_loved
|
-0.069
|
-0.012
|
-0.076*
|
0.147***
|
-0.026
|
0.015
|
-0.023
|
0.028
|
0.001
|
-0.038
|
0.006
|
0.026
|
0.354***
|
Â
|
|
Computed correlation used pearson-method with listwise-deletion.
|
subdata_Threat <-select(data,
sem_diff,
sex,
age,
education,
householdsize,
SEA,
Prob_Einkaufen,
#risk_self,
#risk_loved,
IUS,
STAI,
info_verlauf)
Model_Threat <- lm(sem_diff ~ ., data = subdata_Threat)
#tab_model(Model_Threat,
# show.intercept = FALSE,
# show.ci = FALSE,
# show.se = FALSE,
# show.stat = TRUE,
# #p.style = "scientific",
# string.est = "b",
# string.se = "SE")
summary(Model_Threat)
##
## Call:
## lm(formula = sem_diff ~ ., data = subdata_Threat)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.88960 -0.58585 0.04263 0.59182 2.32513
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.070195 0.033610 2.089 0.03707 *
## sex -0.326107 0.073128 -4.459 9.39e-06 ***
## age -0.086391 0.032460 -2.661 0.00794 **
## education 0.134131 0.029960 4.477 8.67e-06 ***
## householdsize 0.006096 0.030051 0.203 0.83931
## SEA -0.027315 0.031058 -0.879 0.37939
## Prob_Einkaufen 0.256445 0.030895 8.301 4.37e-16 ***
## IUS 0.074628 0.038074 1.960 0.05033 .
## STAI 0.210519 0.038699 5.440 7.08e-08 ***
## info_verlauf 0.268601 0.031352 8.567 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.8467 on 803 degrees of freedom
## Multiple R-squared: 0.291, Adjusted R-squared: 0.283
## F-statistic: 36.62 on 9 and 803 DF, p-value: < 2.2e-16
print_model(df = filtered_data, model = "Baseline", add_variable = "")
|
Â
|
FreqMarch
|
QuaMarch
|
|
Predictors
|
b
|
Statistic
|
p
|
b
|
Statistic
|
p
|
|
sex
|
0.32
|
3.46
|
0.001
|
-0.19
|
-2.05
|
0.040
|
|
age
|
-0.05
|
-1.18
|
0.237
|
-0.09
|
-2.38
|
0.018
|
|
education
|
-0.13
|
-3.49
|
0.001
|
0.11
|
2.95
|
0.003
|
|
householdsize
|
-0.01
|
-0.35
|
0.730
|
0.02
|
0.64
|
0.526
|
|
SEA
|
0.03
|
0.71
|
0.477
|
-0.04
|
-1.09
|
0.278
|
|
Observations
|
678
|
678
|
|
R2 / R2 adjusted
|
0.036 / 0.029
|
0.032 / 0.025
|
print_model(df = filtered_data, model = "specific", add_variable = "sem_diff")
## Note: Using an external vector in selections is ambiguous.
## i Use `all_of(add_variable)` instead of `add_variable` to silence this message.
## i See <https://tidyselect.r-lib.org/reference/faq-external-vector.html>.
## This message is displayed once per session.
|
Â
|
FreqMarch
|
QuaMarch
|
|
Predictors
|
b
|
Statistic
|
p
|
b
|
Statistic
|
p
|
|
sex
|
0.19
|
2.14
|
0.032
|
-0.07
|
-0.74
|
0.457
|
|
age
|
-0.07
|
-1.97
|
0.050
|
-0.07
|
-1.78
|
0.076
|
|
education
|
-0.11
|
-2.99
|
0.003
|
0.09
|
2.44
|
0.015
|
|
householdsize
|
-0.01
|
-0.35
|
0.728
|
0.02
|
0.65
|
0.516
|
|
SEA
|
-0.00
|
-0.08
|
0.939
|
-0.01
|
-0.34
|
0.731
|
|
sem_diff
|
-0.30
|
-8.21
|
<0.001
|
0.29
|
7.86
|
<0.001
|
|
Observations
|
678
|
678
|
|
R2 / R2 adjusted
|
0.124 / 0.116
|
0.114 / 0.106
|
print_model(df = filtered_data, model = "specific", add_variable = "IUS")
|
Â
|
FreqMarch
|
QuaMarch
|
|
Predictors
|
b
|
Statistic
|
p
|
b
|
Statistic
|
p
|
|
sex
|
0.30
|
3.30
|
0.001
|
-0.17
|
-1.86
|
0.064
|
|
age
|
-0.06
|
-1.55
|
0.121
|
-0.07
|
-1.86
|
0.063
|
|
education
|
-0.14
|
-3.62
|
<0.001
|
0.12
|
3.11
|
0.002
|
|
householdsize
|
-0.02
|
-0.44
|
0.659
|
0.03
|
0.76
|
0.448
|
|
SEA
|
0.02
|
0.47
|
0.640
|
-0.03
|
-0.78
|
0.438
|
|
IUS
|
-0.08
|
-2.12
|
0.035
|
0.11
|
2.70
|
0.007
|
|
Observations
|
678
|
678
|
|
R2 / R2 adjusted
|
0.042 / 0.034
|
0.043 / 0.034
|
print_model(df = filtered_data, model = "specific", add_variable = "STAI")
|
Â
|
FreqMarch
|
QuaMarch
|
|
Predictors
|
b
|
Statistic
|
p
|
b
|
Statistic
|
p
|
|
sex
|
0.30
|
3.26
|
0.001
|
-0.17
|
-1.86
|
0.063
|
|
age
|
-0.07
|
-1.72
|
0.085
|
-0.07
|
-1.80
|
0.072
|
|
education
|
-0.14
|
-3.76
|
<0.001
|
0.12
|
3.20
|
0.001
|
|
householdsize
|
-0.02
|
-0.49
|
0.623
|
0.03
|
0.77
|
0.440
|
|
SEA
|
0.01
|
0.18
|
0.859
|
-0.02
|
-0.58
|
0.565
|
|
STAI
|
-0.10
|
-2.57
|
0.010
|
0.10
|
2.42
|
0.016
|
|
Observations
|
678
|
678
|
|
R2 / R2 adjusted
|
0.045 / 0.037
|
0.040 / 0.032
|
print_model(df = filtered_data, model = "specific", add_variable = "risk_self")
|
Â
|
FreqMarch
|
QuaMarch
|
|
Predictors
|
b
|
Statistic
|
p
|
b
|
Statistic
|
p
|
|
sex
|
0.32
|
3.51
|
<0.001
|
-0.19
|
-2.06
|
0.040
|
|
age
|
-0.01
|
-0.18
|
0.858
|
-0.10
|
-2.29
|
0.022
|
|
education
|
-0.14
|
-3.64
|
<0.001
|
0.11
|
2.97
|
0.003
|
|
householdsize
|
-0.02
|
-0.53
|
0.594
|
0.03
|
0.67
|
0.503
|
|
SEA
|
0.02
|
0.58
|
0.559
|
-0.04
|
-1.06
|
0.291
|
|
risk_self
|
-0.17
|
-1.92
|
0.056
|
0.03
|
0.39
|
0.700
|
|
Observations
|
678
|
678
|
|
R2 / R2 adjusted
|
0.041 / 0.033
|
0.032 / 0.024
|
print_model(df = filtered_data, model = "specific", add_variable = "risk_loved")
|
Â
|
FreqMarch
|
QuaMarch
|
|
Predictors
|
b
|
Statistic
|
p
|
b
|
Statistic
|
p
|
|
sex
|
0.31
|
3.35
|
0.001
|
-0.19
|
-2.05
|
0.041
|
|
age
|
-0.04
|
-0.95
|
0.341
|
-0.09
|
-2.34
|
0.020
|
|
education
|
-0.13
|
-3.51
|
<0.001
|
0.11
|
2.95
|
0.003
|
|
householdsize
|
-0.01
|
-0.31
|
0.757
|
0.02
|
0.64
|
0.525
|
|
SEA
|
0.02
|
0.63
|
0.528
|
-0.04
|
-1.09
|
0.277
|
|
risk_loved
|
-0.11
|
-1.46
|
0.145
|
-0.01
|
-0.07
|
0.943
|
|
Observations
|
678
|
678
|
|
R2 / R2 adjusted
|
0.039 / 0.030
|
0.032 / 0.023
|
print_model(df = filtered_data, model = "specific", add_variable = "info_verlauf")
|
Â
|
FreqMarch
|
QuaMarch
|
|
Predictors
|
b
|
Statistic
|
p
|
b
|
Statistic
|
p
|
|
sex
|
0.32
|
3.58
|
<0.001
|
-0.20
|
-2.17
|
0.031
|
|
age
|
0.00
|
0.06
|
0.952
|
-0.14
|
-3.64
|
<0.001
|
|
education
|
-0.13
|
-3.49
|
0.001
|
0.11
|
2.94
|
0.003
|
|
householdsize
|
-0.00
|
-0.10
|
0.920
|
0.01
|
0.38
|
0.705
|
|
SEA
|
0.04
|
1.03
|
0.303
|
-0.05
|
-1.43
|
0.152
|
|
info_verlauf
|
-0.18
|
-4.62
|
<0.001
|
0.19
|
4.93
|
<0.001
|
|
Observations
|
678
|
678
|
|
R2 / R2 adjusted
|
0.066 / 0.057
|
0.066 / 0.058
|
print_model(df = filtered_data, model = "specific", add_variable = "Prob_Einkaufen")
|
Â
|
FreqMarch
|
QuaMarch
|
|
Predictors
|
b
|
Statistic
|
p
|
b
|
Statistic
|
p
|
|
sex
|
0.29
|
3.23
|
0.001
|
-0.16
|
-1.79
|
0.074
|
|
age
|
-0.06
|
-1.52
|
0.130
|
-0.08
|
-2.10
|
0.036
|
|
education
|
-0.14
|
-3.68
|
<0.001
|
0.12
|
3.13
|
0.002
|
|
householdsize
|
-0.01
|
-0.38
|
0.705
|
0.03
|
0.68
|
0.500
|
|
SEA
|
0.02
|
0.40
|
0.686
|
-0.03
|
-0.78
|
0.438
|
|
Prob_Einkaufen
|
-0.19
|
-5.03
|
<0.001
|
0.19
|
5.20
|
<0.001
|
|
Observations
|
678
|
678
|
|
R2 / R2 adjusted
|
0.071 / 0.063
|
0.070 / 0.061
|
subdata_Freq <-select(filtered_data, FreqMarch,
sex,
age,
education,
householdsize,
SEA,
sem_diff,
#risk_self,
#risk_loved,
IUS,
STAI,
info_verlauf,
Prob_Einkaufen)
subdata_Qua <-select(filtered_data, QuaMarch,
sex,
age,
education,
householdsize,
SEA,
sem_diff,
#risk_self,
#risk_loved,
IUS,
STAI,
info_verlauf,
Prob_Einkaufen)
Model_Freq <- lm(FreqMarch ~ ., data = subdata_Freq)
Model_Qua <- lm(QuaMarch ~ ., data = subdata_Qua)
summary(Model_Freq)
##
## Call:
## lm(formula = FreqMarch ~ ., data = subdata_Freq)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.5050 -0.6950 0.1895 0.7284 1.8617
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.046147 0.040839 -1.130 0.25889
## sex 0.208586 0.088555 2.355 0.01879 *
## age -0.044080 0.039247 -1.123 0.26178
## education -0.116909 0.036560 -3.198 0.00145 **
## householdsize -0.007608 0.036117 -0.211 0.83322
## SEA 0.001703 0.037450 0.045 0.96375
## sem_diff -0.239725 0.042787 -5.603 3.09e-08 ***
## IUS 0.047021 0.046100 1.020 0.30811
## STAI -0.039813 0.047347 -0.841 0.40071
## info_verlauf -0.110284 0.039673 -2.780 0.00559 **
## Prob_Einkaufen -0.101949 0.038826 -2.626 0.00884 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.933 on 667 degrees of freedom
## Multiple R-squared: 0.1423, Adjusted R-squared: 0.1295
## F-statistic: 11.07 on 10 and 667 DF, p-value: < 2.2e-16
summary(Model_Qua)
##
## Call:
## lm(formula = QuaMarch ~ ., data = subdata_Qua)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.6772 -0.6880 -0.1595 0.4859 2.8900
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.019108 0.040986 0.466 0.64122
## sex -0.086368 0.088875 -0.972 0.33150
## age -0.096995 0.039389 -2.463 0.01405 *
## education 0.098189 0.036693 2.676 0.00763 **
## householdsize 0.018535 0.036247 0.511 0.60928
## SEA -0.019097 0.037586 -0.508 0.61155
## sem_diff 0.215460 0.042941 5.018 6.72e-07 ***
## IUS -0.007187 0.046267 -0.155 0.87661
## STAI 0.015525 0.047518 0.327 0.74399
## info_verlauf 0.123330 0.039817 3.097 0.00203 **
## Prob_Einkaufen 0.113084 0.038966 2.902 0.00383 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.9364 on 667 degrees of freedom
## Multiple R-squared: 0.1361, Adjusted R-squared: 0.1232
## F-statistic: 10.51 on 10 and 667 DF, p-value: < 2.2e-16
tab_model(Model_Freq, Model_Qua,
show.intercept = FALSE,
show.ci = FALSE,
show.se = FALSE,
show.stat = TRUE,
#p.style = "scientific",
string.est = "b",
string.se = "SE")
|
Â
|
FreqMarch
|
QuaMarch
|
|
Predictors
|
b
|
Statistic
|
p
|
b
|
Statistic
|
p
|
|
sex
|
0.21
|
2.36
|
0.019
|
-0.09
|
-0.97
|
0.332
|
|
age
|
-0.04
|
-1.12
|
0.262
|
-0.10
|
-2.46
|
0.014
|
|
education
|
-0.12
|
-3.20
|
0.001
|
0.10
|
2.68
|
0.008
|
|
householdsize
|
-0.01
|
-0.21
|
0.833
|
0.02
|
0.51
|
0.609
|
|
SEA
|
0.00
|
0.05
|
0.964
|
-0.02
|
-0.51
|
0.612
|
|
sem_diff
|
-0.24
|
-5.60
|
<0.001
|
0.22
|
5.02
|
<0.001
|
|
IUS
|
0.05
|
1.02
|
0.308
|
-0.01
|
-0.16
|
0.877
|
|
STAI
|
-0.04
|
-0.84
|
0.401
|
0.02
|
0.33
|
0.744
|
|
info_verlauf
|
-0.11
|
-2.78
|
0.006
|
0.12
|
3.10
|
0.002
|
|
Prob_Einkaufen
|
-0.10
|
-2.63
|
0.009
|
0.11
|
2.90
|
0.004
|
|
Observations
|
678
|
678
|
|
R2 / R2 adjusted
|
0.142 / 0.129
|
0.136 / 0.123
|
model_food <- lm(NonPerishableFood ~ sex
+ age
+ education
+ householdsize
+ SEA
+ risk_self
+ risk_loved
+ info_verlauf
+ sem_diff
+ Prob_Einkaufen
+ IUS
,data = data_food)
model_hygiene <- lm(HygieneProducts ~ sex
+ age
+ education
+ householdsize
+ SEA
+ risk_self
+ risk_loved
+ info_verlauf
+ sem_diff
+ Prob_Einkaufen
+ IUS
,data = data_hygiene)
model_freshFood <- lm(FreshFood ~ sex
+ age
+ education
+ householdsize
+ SEA
+ risk_self
+ risk_loved
+ info_verlauf
+ sem_diff
+ Prob_Einkaufen
+ IUS
,data = data_freshFood)
tab_model(model_food, model_hygiene, model_freshFood,
show.intercept = FALSE,
show.ci = FALSE,
show.se = FALSE,
show.stat = TRUE,
#p.style = "scientific",
string.est = "b",
string.se = "SE")
|
Â
|
NonPerishableFood
|
HygieneProducts
|
FreshFood
|
|
Predictors
|
b
|
Statistic
|
p
|
b
|
Statistic
|
p
|
b
|
Statistic
|
p
|
|
sex
|
0.04
|
0.48
|
0.631
|
0.11
|
1.28
|
0.199
|
0.13
|
1.44
|
0.149
|
|
age
|
0.09
|
2.30
|
0.022
|
-0.01
|
-0.30
|
0.762
|
-0.08
|
-1.73
|
0.084
|
|
education
|
0.05
|
1.37
|
0.172
|
0.06
|
1.82
|
0.069
|
-0.00
|
-0.02
|
0.982
|
|
householdsize
|
0.02
|
0.64
|
0.522
|
-0.02
|
-0.52
|
0.603
|
-0.02
|
-0.52
|
0.607
|
|
SEA
|
-0.08
|
-2.41
|
0.016
|
-0.06
|
-1.63
|
0.103
|
-0.03
|
-0.72
|
0.470
|
|
risk_self
|
0.02
|
0.29
|
0.769
|
-0.09
|
-1.07
|
0.284
|
0.02
|
0.21
|
0.836
|
|
risk_loved
|
0.17
|
2.33
|
0.020
|
0.09
|
1.17
|
0.241
|
0.12
|
1.54
|
0.125
|
|
info_verlauf
|
0.11
|
3.00
|
0.003
|
0.13
|
3.47
|
0.001
|
0.05
|
1.30
|
0.195
|
|
sem_diff
|
0.21
|
5.56
|
<0.001
|
0.17
|
4.32
|
<0.001
|
0.10
|
2.29
|
0.023
|
|
Prob_Einkaufen
|
0.11
|
2.94
|
0.003
|
0.06
|
1.77
|
0.077
|
0.02
|
0.51
|
0.609
|
|
IUS
|
0.10
|
2.77
|
0.006
|
0.14
|
3.83
|
<0.001
|
0.09
|
2.21
|
0.028
|
|
Observations
|
789
|
801
|
749
|
|
R2 / R2 adjusted
|
0.154 / 0.142
|
0.121 / 0.109
|
0.044 / 0.029
|
summary(model_food)
##
## Call:
## lm(formula = NonPerishableFood ~ sex + age + education + householdsize +
## SEA + risk_self + risk_loved + info_verlauf + sem_diff +
## Prob_Einkaufen + IUS, data = data_food)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.4819 -0.6014 -0.2523 0.2938 4.5515
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.10468 0.05491 -1.906 0.05698 .
## sex 0.03962 0.08238 0.481 0.63066
## age 0.09239 0.04012 2.303 0.02157 *
## education 0.04623 0.03385 1.366 0.17242
## householdsize 0.02127 0.03322 0.640 0.52209
## SEA -0.08240 0.03421 -2.409 0.01625 *
## risk_self 0.02402 0.08163 0.294 0.76860
## risk_loved 0.16717 0.07160 2.335 0.01981 *
## info_verlauf 0.10814 0.03602 3.002 0.00277 **
## sem_diff 0.21415 0.03852 5.559 3.73e-08 ***
## Prob_Einkaufen 0.10538 0.03583 2.941 0.00337 **
## IUS 0.09832 0.03545 2.773 0.00568 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.9265 on 777 degrees of freedom
## Multiple R-squared: 0.1536, Adjusted R-squared: 0.1416
## F-statistic: 12.82 on 11 and 777 DF, p-value: < 2.2e-16
summary(model_hygiene)
##
## Call:
## lm(formula = HygieneProducts ~ sex + age + education + householdsize +
## SEA + risk_self + risk_loved + info_verlauf + sem_diff +
## Prob_Einkaufen + IUS, data = data_hygiene)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.5650 -0.5980 -0.2450 0.3077 4.6122
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.03145 0.05577 -0.564 0.572975
## sex 0.10730 0.08354 1.284 0.199378
## age -0.01229 0.04063 -0.302 0.762427
## education 0.06274 0.03443 1.822 0.068808 .
## householdsize -0.01761 0.03380 -0.521 0.602507
## SEA -0.05646 0.03460 -1.632 0.103092
## risk_self -0.08835 0.08241 -1.072 0.284031
## risk_loved 0.08503 0.07249 1.173 0.241129
## info_verlauf 0.12644 0.03648 3.466 0.000557 ***
## sem_diff 0.16968 0.03924 4.324 1.73e-05 ***
## Prob_Einkaufen 0.06454 0.03649 1.769 0.077312 .
## IUS 0.13843 0.03615 3.830 0.000139 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.9441 on 789 degrees of freedom
## Multiple R-squared: 0.1209, Adjusted R-squared: 0.1086
## F-statistic: 9.861 on 11 and 789 DF, p-value: < 2.2e-16
summary(model_freshFood)
##
## Call:
## lm(formula = FreshFood ~ sex + age + education + householdsize +
## SEA + risk_self + risk_loved + info_verlauf + sem_diff +
## Prob_Einkaufen + IUS, data = data_freshFood)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.0331 -0.5156 -0.3702 -0.0950 4.6539
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.0910427 0.0600216 -1.517 0.1297
## sex 0.1296775 0.0898013 1.444 0.1492
## age -0.0758529 0.0438825 -1.729 0.0843 .
## education -0.0008191 0.0367720 -0.022 0.9822
## householdsize -0.0185583 0.0360158 -0.515 0.6065
## SEA -0.0274428 0.0379964 -0.722 0.4704
## risk_self 0.0183648 0.0884437 0.208 0.8356
## risk_loved 0.1198622 0.0780488 1.536 0.1250
## info_verlauf 0.0509697 0.0393037 1.297 0.1951
## sem_diff 0.0961733 0.0420819 2.285 0.0226 *
## Prob_Einkaufen 0.0200107 0.0390751 0.512 0.6087
## IUS 0.0853787 0.0386950 2.206 0.0277 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.9852 on 737 degrees of freedom
## Multiple R-squared: 0.04366, Adjusted R-squared: 0.02938
## F-statistic: 3.059 on 11 and 737 DF, p-value: 0.000507
group_fre <- c()
group_fre[data_sample$FreqMarch < 0] <- "less"
group_fre[data_sample$FreqMarch == 0] <- "same"
group_fre[data_sample$FreqMarch > 0] <- "more"
group_qua <- c()
group_qua[data_sample$QuaMarch < 0] <- "less"
group_qua[data_sample$QuaMarch == 0] <- "same"
group_qua[data_sample$QuaMarch > 0] <- "more"
df_gr <- data.frame(group_fre, group_qua)
df_gr$group_fre <- factor(df_gr$group_fre, levels = c("less", "same", "more"))
df_gr$group_qua <- factor(df_gr$group_qua, levels = c("less", "same", "more"))
Fig1 <- ggplot(data = df_gr, aes(x=group_fre, label = scales::percent(prop.table(stat(count)), accuracy = 0.1L)))+
geom_bar(fill = "#FF0000")+
ylab("Number of Observations")+
xlab("Change in Purchasing Frequency")+
geom_text(stat = 'count',
position = position_dodge(.9),
vjust = -0.5,
size = 3)
Fig2 <- ggplot(data = df_gr, aes(x=group_qua,label = scales::percent(prop.table(stat(count)), accuracy = 0.1L)))+
geom_bar(fill = "#FF0000")+
ylab("Number of Observations")+
xlab("Change in Purchasing Quantity")+
geom_text(stat = 'count',
position = position_dodge(.9),
vjust = -0.5,
size = 3)
Fig1
Fig2
