The echo = FALSE
parameter was added to the code chunk
to prevent printing of the R code that generated the plot.
We loaded the packages needed to reproduce results mentioned in our verification goals.
library(tidyverse) # general data wrangling
library(psych) # to use describeBy() function
library(flextable) # to format correlation table
library(gridExtra) # to combine two plots into one frame
We uploaded and read the open raw data files provided by the authors.
Data1 <- read.csv("Study 1 data.csv")
Data2 <- read.csv("Study 2.csv")
count(Data1)
Data1 %>%
group_by(Participant = "Participant.ID") %>%
count()
# Filter out no responses (decline to answer)
Data1_Age <- Data1 %>%
filter (Age != "[Decline to Answer]")
# Change the age frame from character to numeric
Data1_Age$Age <- as.numeric(Data1_Age$Age)
# Calculate mean and SD
Data1_Age %>%
summarise(M = mean(Age),
SD = sd(Age))
## Filter out the no responses (decline to answer)
Data1_Gender <- Data1 %>%
filter (Gender != "[Decline to Answer]")
## Calculate percentage of woman
Data1_Gender %>%
group_by(Gender) %>%
filter(Gender == 'Woman') %>%
summarise(Percentage = n()/nrow(Data1_Gender)*100)
# Create new function to calculate mode
find_mode <- function(x) {
u <- unique(x)
tab <- tabulate(match(x, u))
u[tab == max(tab)]}
# Calculate mode, mean and SD
Data1 %>%
group_by("SixFeet") %>%
summarise(Mode = find_mode(SixFeet),
M = mean(SixFeet),
SD = sd(SixFeet))
# Create a new data frame for correlation
Corr1 <- Data1 %>%
select(LETHAVERAGE.T1:EXTRAVERSION) %>% # Select variables needed
cor() %>% # Calculate corr. value between each variable
round(digits=2) %>% # Round corr. value of to 2 dp
str_remove("^0+") %>% # Remove pos leading zeros
str_remove("(?<=-)(.*?)(.)") %>% # Remove neg leading zeros
matrix(nrow=7, ncol=7) %>% # Turn characters from string back to table
as.data.frame() # Convert to data frame
# Calculate mean and SD for each selected variable
Data1 %>%
select(LETHAVERAGE.T1:EXTRAVERSION) %>%
describeBy()
# Insert a row of mean and SD values to table
new_row <- c("2.60 (1.16)", "3.16 (1.27)", "0.56 (1.33)", "4.11 (0.88)",
"3.97 (0.85)", "-0.14 (0.71)", "4.17 (1.01)")
Corr1 <- Corr1 %>% rbind(new_row)
# Rename the variables
rownames(Corr1) <- c("T1 Lethargy", "T2 Lethargy", "Lethargy diff (T2-T1)",
"T1 Social Connectedness", "T2 Social Connectedness",
"Connectedness diff (T2-T1)", "Extraversion", "Mean (SD)")
colnames(Corr1) <- c("T1 Lethargy", "T2 Lethargy", "Lethargy diff (T2-T1)",
"T1 Social Connectedness", "T2 Social Connectedness",
"Connectedness diff (T2-T1)", "Extraversion")
# Remove duplicate values in upper triangular part of table
Corr1[upper.tri(Corr1)]<- ""
# Insert row names
new_col <- c("T1 Lethargy", "T2 Lethargy", "Lethargy diff (T2-T1)",
"T1 Social Connectedness", "T2 Social Connectedness",
"Connectedness diff (T2-T1)", "Extraversion", "Mean (SD)")
Corr1 <- Corr1 %>% bind_cols(new_col)
Corr1 <- Corr1[,c(8,1,2,3,4,5,6,7)]
# Table formatting
Corr1 %>% flextable() %>%
font(fontname = "Times New Roman", part = "all") %>%
bold(bold = TRUE, part = "header") %>%
set_header_labels( ...8 = "") %>%
border_remove() %>%
add_header_row(colwidths = c(8),
values = c("Table 1: Means and Correlations Among Variables at Time 1 and Time 2 (Study 1)")) %>%
hline_top()
hist(Data1$SCdiff,
main = "Distribution of Social Connectedness Difference Score", # title
xlab ="Social Connectedness Difference Score (T2-T1)", # x-axis label
xlim=c(-3,3), ylim = c(0,200), # x-axis and y-axis limits
las = 1, # y-axis orientation to horizontal
xaxt = "n") # remove existing x-axis
axis(1, pos=0) # add axis and positioning
Data2 %>% # Base data frame
group_by(Participant = "Participant.ID") %>% # Self-explanatory output
count() # Calculate n in defined group
# Filter out no responses (decline to answer)
Data2_Age <- Data2 %>% # Create new data frame
filter (Age != "[Decline to Answer]") # Exclude no-answer participants
# Change the age frame from character to numeric
Data2_Age$Age <- as.numeric(Data2_Age$Age)
# Calculate mean and SD
Data2_Age %>% # Age data frame
group_by("Age") %>% # Self-explanatory output
summarise(M = mean(Age), # Calculate mean
SD = sd(Age)) # Calculate SD
# Have to filter out the no responses (decline to answer)
Data2_Gender <- Data2 %>% # Create new data frame
filter (Gender != "[Decline to Answer]") # Exclude no-answer participants
# Calculate percentage of male
Data2_Gender %>% # Gender data frame
group_by(Gender) %>% # Self-explanatory output
filter(Gender == 'Male') %>% # Filter males
summarise(Percentage = n()/nrow(Data2_Gender)*100) # Calculate percentage
Data2 %>% # Base data frame
group_by(Ethnicity) %>% # Self-explanatory output
filter(Ethnicity == 'White') %>% # Filter whites
summarise(Percentage = n()/nrow(Data2)*100) # Calculate percentage
Data2 %>% # Base data frame
group_by(Country) %>% # Self-explanatory output
filter(Country == 'USA' | Country == 'UK') %>% # Filter US, UK residents
summarise(Percentage = n()/nrow(Data2)*100) # Calculate percentage
Data2 %>% # Base data frame
group_by("Extraversion") %>% # Self-explanatory output
summarise(M = mean(T1Extraversion), # Calculate mean
SD = sd(T1Extraversion)) # Calculate SD
Data2 %>% # Base data frame
group_by("SixFeet") %>% # Self-explanatory output
summarise(Mode = find_mode(SixFeet), # Calculate mode
M = mean(SixFeet), # Calculate mean
SD = sd(SixFeet)) # Calculate SD
# Combining two histograms into one frame
par(mfrow = c(1,2))
# Relatedness histogram
histBMPN <- hist(Data2$BMPN_Diff,
main = "Distribution of Relatedness Difference Scores", # title
xlab = "Relatedness Difference Score (T2-T1)", # x-axis label
xlim = c(-4,4), ylim = c(0,80), # x-axis and y-axis limits
las = 1, # y-axis orientation to horizontal
breaks = 13,
xaxt = "n") # remove existing x-axis
axis(1, pos=0) # add axis and positioning
# Loneliness histogram
histLonely <- hist(Data2$Lonely_Diff,
main = "Distribution of Loneliness Scores", # title
xlab = "Loneliness Difference Score (T2-T1)", # x-axis label
xlim = c(-2,2), ylim = c(0,50), # x-axis and y-axis limits
breaks = 40, # define number of bars
xaxt = "n", yaxt = "n") # remove existing x- and y-axis
axis(1, pos = 0) # add x-axis and positioning
axis(2, pos = -2, # add y-axis and positioning
las = 1) # y-axis orientation to horizontal
# Create a new data frame for correlation
Corr2 <- Data2 %>%
select(T1Extraversion:BMPN_Diff) %>% # Select variables needed
cor() %>% # Calculate corr. value between each variable
round(digits=2) %>% # Round corr. value of to 2 dp
str_remove("^0+") %>% # Remove pos leading zeros
str_remove("(?<=-)(.*?)(.)") %>% # Remove neg leading zeros
matrix(nrow=10, ncol=10) %>% # Turn characters from string back to table
as.data.frame() # Convert to data frame
# Rearrange Extraversion and Relatedness variables to match the order in original table
Corr2 <- Corr2[,c(2,3,4,8,9,10,5,6,7,1)] # Move columns
Corr2 <- Corr2[c(2,3,4,8,9,10,5,6,7,1),] # Move rows
# Calculate mean and SD for each selected variable
Data2 %>%
select(T1Extraversion:BMPN_Diff) %>%
describeBy()
# Insert a row of mean and SD values to table
new_row2 <- c("3.97 (1.53)", "3.99 (1.45)", "0.02 (0.88)", "4.92 (1.09)",
"4.91 (1.14)", "–0.01 (1.11)", "2.12 (0.65)", "2.06 (0.62)",
"–0.06 (0.40)", "3.90 (0.79)")
Corr2 <- Corr2 %>% rbind(new_row2)
# Rename the variables
rownames(Corr2) <- c("T1 Life Satisfaction", "T2 Life Satisfaction",
"Life Satisfaction Change (T2-T1)", "T1 Relatedness",
"T2 Relatedness", "Relatedness change (T2-T1)", "T1 Loneliness",
"T2 Loneliness", "Loneliness change (T2-T1)",
"T1 Extraversion", "Mean (SD)")
colnames(Corr2) <- c("T1 Life Satisfaction", "T2 Life Satisfaction",
"Life Satisfaction change (T2-T1)", "T1 Relatedness",
"T2 Relatedness", "Relatedness change (T2-T1)",
"T1 Loneliness", "T2 Loneliness",
"Loneliness change (T2-T1)", "T1 Extraversion")
# Remove duplicate values in upper triangular part of table
Corr2[upper.tri(Corr2)]<- ""
# Insert row names
new_col2 <- c("T1 Life Satisfaction", "T2 Life Satisfaction",
"Life Satisfaction change (T2-T1)", "T1 Relatedness",
"T2 Relatedness", "Relatedness change (T2-T1)",
"T1 Loneliness", "T2 Loneliness", "Loneliness change (T2-T1)",
"T1 Extraversion", "Mean(SD)")
Corr2 <- Corr2 %>% bind_cols(new_col2)
Corr2 <- Corr2[,c(11,1,2,3,4,5,6,7,8,9,10)]
# Table formatting
Corr2 %>% flextable() %>%
font(fontname = "Times New Roman", part = "all") %>%
bold(bold = TRUE, part = "header") %>%
set_header_labels( ...11 = "") %>%
border_remove() %>%
add_header_row(colwidths = c(11),
values = c("Table 3: Correlations Among Variables for Time 1 and Time 2 (Study 2)")) %>%
hline_top()
# Social connectedness figure
## Create new data frame
Extraversion <- c("Most Introverted", "Most Introverted",
"Most Extraverted", "Most Extraverted")
N <- c("119", "119", "130", "130")
Time <- c("Before Pandemic", "During Pandemic",
"Before Pandemic", "During Pandemic")
Mean <- c("3.45", "3.35", "4.70", "4.45")
SE <- c("0.06", "0.06", "0.06", "0.07")
Fig3_SC <- data.frame(Extraversion, N, Time, Mean, SE)
## Set numerical variables to numerics format
Fig3_SC$N <- as.numeric(Fig3_SC$N)
Fig3_SC$Mean <- as.numeric(Fig3_SC$Mean)
Fig3_SC$SE <- as.numeric(Fig3_SC$SE)
## Calculate CI
Fig3_SC <- Fig3_SC %>%
mutate(LowerCI = Mean - qt(1 - (0.05 / 2), N - 1) * SE,
UpperCI = Mean + qt(1 - (0.05 / 2), N - 1) * SE)
## Plot graph
ggplotSC <- ggplot(Fig3_SC, aes(x = Time, y = Mean, group = Extraversion)) +
geom_point(aes(group = Mean), size = 3.5) +
geom_errorbar(aes(ymin = LowerCI, ymax = UpperCI),
width = 0.1) +
geom_line(aes(linetype = Extraversion), size = 1.65) +
ggtitle("Social Connectedness Changes based on Extraversion") +
theme(plot.title = element_text(hjust = 0.5),
legend.position = "none",
panel.background = element_blank(),
axis.line = element_line()) +
ylab("Mean Social Connectedness") +
expand_limits(y=3) + expand_limits(y=5)
# Loneliness figure
## Create new data frame
Extraversion <- c("Most Introverted", "Most Introverted",
"Most Extraverted", "Most Extraverted")
N <- c("80", "80", "83", "83")
Time <- c("Before Pandemic", "During Pandemic",
"Before Pandemic", "During Pandemic")
Mean <- c("2.53", "2.31", "1.63", "1.67")
SE <- c("0.07", "0.07", "0.05", "0.05")
Fig3_Lonely <- data.frame(Extraversion, N, Time, Mean, SE)
## Set numerical variables to numerics format
Fig3_Lonely$N <- as.numeric(Fig3_Lonely$N)
Fig3_Lonely$Mean <- as.numeric(Fig3_Lonely$Mean)
Fig3_Lonely$SE <- as.numeric(Fig3_Lonely$SE)
## Calculate CI
Fig3_Lonely <- Fig3_Lonely %>%
mutate(LowerCI = Mean - qt(1 - (0.05 / 2), N - 1) * SE,
UpperCI = Mean + qt(1 - (0.05 / 2), N - 1) * SE)
## Plot graph
ggplotLonely <- ggplot(Fig3_Lonely, aes(x = Time,
y = Mean,
group = Extraversion)) +
geom_point(aes(group = Mean), size = 3.5) +
geom_errorbar(aes(ymin = LowerCI, ymax = UpperCI),
width = 0.1) +
geom_line(aes(linetype = Extraversion), size = 1.65) +
ggtitle("Loneliness Changes based on Extraversion") +
theme(plot.title = element_text(hjust = 0.5),
legend.title=element_blank(),
panel.background = element_blank(),
axis.line = element_line()) +
ylab("Mean Loneliness") +
expand_limits(y=1) + expand_limits(y=3)
# Combining two ggplots into one frame
grid.arrange(ggplotSC, ggplotLonely, ncol=2, widths=c(3,4))
# Categorise Age Groups
Data2_AgeGroup <- Data2_Age %>%
mutate(AgeGroup = case_when(Age >= 50 & Age <= 72 ~ 'Seniors',
Age >= 36 & Age <= 49 ~ 'Middle Age',
Age >= 23 & Age <= 35 ~ 'Adults',
Age >= 18 & Age <= 22 ~ 'Young Adults'))
# Calculate mean
Data2_AgeGroup %>%
group_by(AgeGroup) %>%
summarise(T1 = mean(T1Lonely),
T2 = mean(T2Lonely)) # ANSWER TO QUESTION 1
Social Connectedness at Time 1 (M = 4.11, SD = 0.88)