Week 5 Learning Log

Hi PSYC3361,

Welcome to my learning log for Week 5!

This week was the first week that I started working on the code for our COVID article. However, we have made incredible progress during this time! As of the end of this week, we have reproduced all code for the statistics and figures that we set out to. We haven’t finished reproducing all the aesthetics but it’s great to have the bulk of the work completed. It certianly hasn’t been easy and without our amazing group member Carla Pham and her incredible coding skills, Charlie and I would have been stuck on reproducing descriptive stats! On that note, I’ll go through some of the things that we’ve done:

Demographic Statistics

Load library

library(tidyverse)

Load study data for study 1

study1rawdata=read_csv(“Data/WTR_Comfort_S1.csv”)

Find number of participants

nparticipants = nrow(study1rawdata)

Print it into console

print (nparticipants)

Find percentage of male participants:

study1rawdata\(sex <- as.factor(study1rawdata\)sex) study1rawdata %>% count(sex==“1”)

Find mean and SD of participants’ age, print it into console to get it to show & round to 2 dp:

mean_age = mean(study1rawdata$age) print(round(mean_age, digits = 2))

sd_age = sd(study1rawdata$age) print(round(sd_age, digits = 2))

Data exclusions

Find english exclusions

Exclude_english_s1 <- filter(study1rawdata, English_exclude == “1”) print(nrow(Exclude_english_s1))

Find non-male/female exclusions

exclude_sex_s1 <- filter(study1rawdata, sex == “3”) print(nrow(exclude_sex_s1))

The console code:

#Demographic descriptives

#Find number of participants

nparticipants = nrow(study1rawdata)

#Print it into console

print (nparticipants)

[1] 504

#Find percentage of male participants

study1rawdata\(sex <- as.factor(study1rawdata\)sex)

study1rawdata %>% count(sex==“1”)

#A tibble: 2 x 2

sex == "1" n

1 FALSE 226

2 TRUE 278

#Find mean and SD of participants’ age

mean_age = mean(study1rawdata$age)

#Print it into console to get it to show & round to 2 dp

print(round(mean_age, digits = 2))

[1] 35.88

sd_age = sd(study1rawdata$age)

print(round(sd_age, digits = 2))

[1] 10.2

#Data exclusions

#Find english exclusions

Exclude_english_s1 <- filter(study1rawdata, English_exclude == “1”)

print(nrow(Exclude_english_s1))

[1] 3

#Find non-male/female exclusions

exclude_sex_s1 <- filter(study1rawdata, sex == “3”)

print(nrow(exclude_sex_s1))

[1] 2

Violin Plots

Load library tidyverse and patchwork

library(tidyverse) library(patchwork) library(ggplot2)

Load data 1,2, & 3

data_1_raw = read_csv(‘WTR_Comfort_S1.csv’) data_2 = read_csv(‘WTR_Comfort_S2.csv’) data_3 = read_csv(‘WTR_Comfort_S3.csv’)

Plot Study 1 violin plot

data_1 <- data_1_raw %>% mutate( avg_cc = rowMeans(select(., comf1:comf10) -4) )

data_1\(relationship_category <- as.factor(data_1\)relationship_category)

Figure1_data_1 <- ggplot(data_1, aes(relationship_category, avg_cc) ) + geom_violin( aes( fill = relationship_category, alpha = .9) ) + geom_boxplot( aes( colour = NULL), outlier.colour = NULL, outlier.shape = 16, outlier.size = 1, notch = FALSE, width = 0.1, border=c(NULL), ) + scale_x_discrete( name = NULL, labels = c(‘Romantic Partner’, ‘Friend’, ‘Acquaintance’, ‘Enemy’) ) + scale_y_continuous( name = ‘Contact Comfort’, n.breaks = 7) + labs(title = “Study 1”) + theme( panel.background = element_rect( fill = “transparent”, color = NA), legend.position = “none”, plot.title = element_text(hjust = 0.5) ) + scale_fill_manual( values = c(“#3F6485”,“#B17276”, “#829966”, “#FFDB6D”) ) + scale_colour_manual(values = c(“#3F6485”,“#B17276”, “#829966”, “#FFDB6D”))

print(Figure1_data_1)

Plot study 2 violin plot

data_2 <- data_2 %>% mutate( avg_cc = rowMeans(select(., comf1:comf10)-4) )

data_2\(target_category <- as.factor(data_2\)target_category)

Figure2_data_2 <- ggplot(data_2, aes(target_category, avg_cc) ) + geom_violin(aes (fill = target_category, alpha = .9) ) + geom_boxplot(aes (colour = NULL), outlier.colour = NULL, outlier.shape = 16, outlier.size = 1, notch = FALSE, width = 0.1, border=c(NULL), ) + scale_x_discrete( name = NULL, labels = c(‘Friend’, ‘Acquaintance’, ‘Enemy’) )+ scale_y_continuous(NULL) + labs(title = “Study 2”) + theme( panel.background = element_rect( fill = “transparent”, color = NA), legend.position = “none”, plot.title = element_text(hjust = 0.5) ) + scale_fill_manual( values = c(“#B17276”, “#829966”, “#FFDB6D”) ) + scale_colour_manual(values = c(“#B17276”, “#829966”, “#FFDB6D”) ) print(Figure2_data_2)

Plot study 3 violin plot

data_3 <- data_3 %>% mutate(avg_cc = rowMeans(select(., comf1:comf10)-4))

data_3\(Value = as.factor(data_3\)Value) data_3\(Value = factor(data_3\)Value, levels = c(1, 0))

Figure3_data_3 <- ggplot(data_3, aes(Value, avg_cc)) + geom_violin(aes(fill = Value, alpha = .9)) + geom_boxplot(aes(colour = NULL), outlier.colour = NULL, outlier.shape = 16, outlier.size = 1, notch = FALSE, width = 0.1 ) + scale_x_discrete(name = NULL, labels = c(‘High-Value Stranger’, ‘Low-Value Stranger’ ))+ scale_y_continuous(name = ‘Contact Comfort’, n.breaks = 7) + labs(title = “Study 3”) + theme(panel.background = element_rect(fill = “transparent”, color = NA), legend.position = “none”, plot.title = element_text(hjust = 0.5)) + scale_fill_manual(values = c(“#B17276”, “#3F6485” ))

print(Figure3_data_3)

Patch Study 1, 2, and 3 violin plots together and remove background and y-axis from study 2 and 3 plots

Figure1_data_1 + Figure2_data_2 + Figure3_data_3 + theme( axis.text.y = element_blank(), axis.ticks.y = element_blank(), axis.title.y = element_blank() )

The console code:

#load library tidyverse and patchwork library(tidyverse) library(patchwork) library(ggplot2)

#load data 1,2, & 3 data_1_raw = read_csv(‘WTR_Comfort_S1.csv’)

── Column specification ────────────────────────────────────────────────────────────────────────────────────────────────── cols( .default = col_double() ) ℹ Use spec() for the full column specifications.

data_2 = read_csv(‘WTR_Comfort_S2.csv’)

── Column specification ────────────────────────────────────────────────────────────────────────────────────────────────── cols( .default = col_double() ) ℹ Use spec() for the full column specifications.

data_3 = read_csv(‘WTR_Comfort_S3.csv’)

── Column specification ────────────────────────────────────────────────────────────────────────────────────────────────── cols( .default = col_double() ) ℹ Use spec() for the full column specifications.

#Plot Study 1 violin plot

data_1 <- data_1_raw %>% + mutate( + avg_cc = rowMeans(select(., comf1:comf10) -4) + )

data_1\(relationship_category <- as.factor(data_1\)relationship_category)

Figure1_data_1 <- ggplot(data_1, + aes(relationship_category, avg_cc) + ) + + geom_violin( + aes( + fill = relationship_category, + alpha = .9) + ) + + geom_boxplot( + aes( + colour = NULL), + outlier.colour = NULL, + outlier.shape = 16, + outlier.size = 1, + notch = FALSE, + width = 0.1, + border=c(NULL), + ) + + scale_x_discrete( + name = NULL, + labels = c(‘Romantic Partner’, ‘Friend’, ‘Acquaintance’, ‘Enemy’) + ) + + scale_y_continuous( + name = ‘Contact Comfort’, + n.breaks = 7) + + labs(title = “Study 1”) + + theme( + panel.background = element_rect( + fill = “transparent”, + color = NA), + legend.position = “none”, + plot.title = element_text(hjust = 0.5) + ) + + scale_fill_manual( + values = c(“#3F6485”,“#B17276”, “#829966”, “#FFDB6D”) + ) + + scale_colour_manual(values = c(“#3F6485”,“#B17276”, “#829966”, “#FFDB6D”)) Warning message: Ignoring unknown parameters: border

print(Figure1_data_1) Warning messages: 1: Removed 4 rows containing non-finite values (stat_ydensity). 2: Removed 4 rows containing non-finite values (stat_boxplot).

#Plot study 2 violin plot

data_2 <- data_2 %>% + mutate( + avg_cc = rowMeans(select(., comf1:comf10)-4) + )

data_2\(target_category <- as.factor(data_2\)target_category)

Figure2_data_2 <- ggplot(data_2, + aes(target_category, avg_cc) + ) + + geom_violin(aes + (fill = target_category, + alpha = .9) + ) + + geom_boxplot(aes + (colour = NULL), + outlier.colour = NULL, + outlier.shape = 16, + outlier.size = 1, + notch = FALSE, + width = 0.1, + border=c(NULL), + ) + + scale_x_discrete( + name = NULL, + labels = c(‘Friend’, ‘Acquaintance’, ‘Enemy’) + )+ + scale_y_continuous(NULL) + + labs(title = “Study 2”) + + theme( + panel.background = element_rect( + fill = “transparent”, color = NA), + legend.position = “none”, + plot.title = element_text(hjust = 0.5) + ) + + scale_fill_manual( + values = c(“#B17276”, “#829966”, “#FFDB6D”) + ) + + scale_colour_manual(values = c(“#B17276”, “#829966”, “#FFDB6D”) + ) Warning message: Ignoring unknown parameters: border print(Figure2_data_2) Warning messages: 1: Removed 6 rows containing non-finite values (stat_ydensity). 2: Removed 6 rows containing non-finite values (stat_boxplot).

#Plot study 3 violin plot

data_3 <- data_3 %>% + mutate(avg_cc = rowMeans(select(., comf1:comf10)-4))

data_3\(Value = as.factor(data_3\)Value) data_3\(Value = factor(data_3\)Value, levels = c(1, 0))

Figure3_data_3 <- ggplot(data_3, aes(Value, avg_cc)) + + geom_violin(aes(fill = Value, alpha = .9)) + + geom_boxplot(aes(colour = NULL), outlier.colour = NULL, + outlier.shape = 16, outlier.size = 1, notch = FALSE, + width = 0.1 + ) + scale_x_discrete(name = NULL, + labels = c(‘High-Value Stranger’, ‘Low-Value Stranger’ + ))+ + scale_y_continuous(name = ‘Contact Comfort’, n.breaks = 7) + + labs(title = “Study 3”) + + theme(panel.background = element_rect(fill = “transparent”, color = NA), + legend.position = “none”, + plot.title = element_text(hjust = 0.5)) + + scale_fill_manual(values = c(“#B17276”, “#3F6485” ))

print(Figure3_data_3) Warning messages: 1: Removed 5 rows containing non-finite values (stat_ydensity). 2: Removed 5 rows containing non-finite values (stat_boxplot).

#Patch Study 1 and Study 2 violin plots together

Figure1_data_1 + Figure2_data_2 + Figure3_data_3 + + theme( + axis.text.y = element_blank(), + axis.ticks.y = element_blank(), + axis.title.y = element_blank() + ) Warning messages: 1: Removed 4 rows containing non-finite values (stat_ydensity). 2: Removed 4 rows containing non-finite values (stat_boxplot). 3: Removed 6 rows containing non-finite values (stat_ydensity). 4: Removed 6 rows containing non-finite values (stat_boxplot). 5: Removed 5 rows containing non-finite values (stat_ydensity). 6: Removed 5 rows containing non-finite values (stat_boxplot).

Our plots vs. The article plots

Ours:

Tybur et al. (2020)

Complex scatter plots with regression line

Plot Figure 2 for Study 1

data_1 = read_csv(‘WTR_Comfort_S1.csv’)

data_1<-filter(data_1,English_exclude==0)

rawCC<-data_1[,30:39] rawCC<-as.data.frame(as.matrix(rawCC)-4)

rawWTR_1<-data_1[,c(49:40,59:50,69:60,79:70,89:80,99:90)] rawWTR_1\('37_-13'[which(rawWTR_1\)’37_-13’==-.45)]<-0 rawWTR_1\('23_-8'[which(rawWTR_1\)’23_-8’==-.45)]<-0 rawWTR_1\('75_-26'[which(rawWTR_1\)’75_-26’==-.45)]<-0 rawWTR_1\('19_-7'[which(rawWTR_1\)’19_-7’==-.45)]<-0 rawWTR_1\('46_-16'[which(rawWTR_1\)’46_-16’==-.45)]<-0 rawWTR_1\('68_-24'[which(rawWTR_1\)’68_-24’==-.45)]<-0 rawWTRdummy<-as.matrix(rawWTR_1) rawWTRdummy[rawWTRdummy!=0]<-1 rawWTR_1<-as.data.frame(rawWTRdummy) rm(rawWTRdummy) participantnumber <- 1 Caulsum <- matrix(,,ncol=9) Caulsum <- Caulsum[-1,] colnames(Caulsum) <- c(“WTR37”,“WTR23”,“WTR75”,“WTR19”,“WTR46”,“WTR68”,“WTRTOTAL”,‘DS’,‘HH’) wtrcal <- function(rawWTR) { rawWTR <- as.numeric(rawWTR) m <- seq(-35, 145, by = 20) if(sum(rawWTR) == 10){ anchorWTR = 1.55 }else if(sum(rawWTR) == 0){ anchorWTR = -0.45 }else{ shiftcount = 0 shiftpoint = 0 for(i in 1:9){ if((rawWTR[i] - rawWTR[i + 1]) == 1){ shiftcount = shiftcount + 1 shiftpoint <- (m[i] + m[i + 1])/2 + shiftpoint } } if (shiftcount > 2) { anchorWTR = NA } else { anchorWTR <- 0.01*shiftpoint/shiftcount } } } while (participantnumber <= nrow(data_1)) { dumx <- rawWTR_1[participantnumber,] dummysheetWTR <- matrix(data = dumx, ncol = 10, byrow = TRUE) colnames(dummysheetWTR) <- seq(-35, 145, by = 20) WTRAnchor <- apply(dummysheetWTR, 1, wtrcal) if(NA%in%WTRAnchor){ WTRTotal<-NA }else{ WTRTotal<-mean(WTRAnchor) } Caulperson <- matrix(c(WTRAnchor,WTRTotal), ncol = 9) Caulsum <- rbind(Caulsum,Caulperson) participantnumber<-participantnumber+1 } Caulsum<-as.data.frame(Caulsum) Caulsum<-round(Caulsum, digits = 3) Caulsum<-mutate(Caulsum,dummy=c(1:501)) rawCC<-mutate(rawCC,dummy=c(1:501)) Caulsum<-merge.data.frame(Caulsum,rawCC,by=‘dummy’) Finaldata_1<-as.data.frame(filter(mutate(Caulsum,sex=data_1\(sex,age=data_1\)age,part_sex=data_1\(part_sex,relation=data_1\)relationship_category, income=data_1\(income,part_age=data_1\)part_age,part_leng=data_1\(part_leng,spa=data_1\)poli_soc,epa=data_1\(poli_econ, trust=data_1\)trust_gen), sex!=3)) Finaldata_1<-Finaldata_1[complete.cases(Finaldata_1$WTRTOTAL),] Finaldata_1<-mutate(Finaldata_1,CC=unname(rowMeans(select(Finaldata_1,comf1:comf10)))) plot_1 = ggplot(Finaldata_1, aes(WTRTOTAL, CC)) + geom_point() + geom_smooth(aes(group = relation), method = ‘lm’) + geom_smooth(method = ‘lm’) print(plot_1)

Plot Figure 2 for Study 2

data_2 = read_csv(‘WTR_Comfort_S2.csv’)

data_2<-filter(data_2,English_exclude==0) rawCC<-data_2[,45:54] rawCC<-as.data.frame(as.matrix(rawCC)-4) rawWTR_2<-data_2[,c(64:55,74:65,84:75)] rawWTR_2\('75_-26'[which(rawWTR_2\)’75_-26’==-.45)]<-0 rawWTR_2\('19_-7'[which(rawWTR_2\)’19_-7’==-.45)]<-0 rawWTR_2\('46_-16'[which(rawWTR_2\)’46_-16’==-.45)]<-0 rawWTRdummy<-as.matrix(rawWTR_2) rawWTRdummy[rawWTRdummy!=0]<-1 rawWTR_2<-as.data.frame(rawWTRdummy) rm(rawWTRdummy) participantnumber <- 1 Caulsum <- matrix(,,ncol=7) Caulsum <- Caulsum[-1,] colnames(Caulsum) <- c(“WTR75”,“WTR19”,“WTR46”,“WTRTOTAL”,‘DS’,‘HH’,‘AG’) wtrcal <- function(rawWTR) { rawWTR <- as.numeric(rawWTR) m <- seq(-35, 145, by = 20) if(sum(rawWTR) == 10){ anchorWTR = 1.55 }else if(sum(rawWTR) == 0){ anchorWTR = -0.45 }else{ shiftcount = 0 shiftpoint = 0 for(i in 1:9){ if((rawWTR[i] - rawWTR[i + 1]) == 1){ shiftcount = shiftcount + 1 shiftpoint <- (m[i] + m[i + 1])/2 + shiftpoint } } if (shiftcount > 2) { anchorWTR = NA } else { anchorWTR <- 0.01*shiftpoint/shiftcount } } } while (participantnumber <= nrow(data_2)) { dumx <- rawWTR_2[participantnumber,] dummysheetWTR <- matrix(data = dumx, ncol = 10, byrow = TRUE) colnames(dummysheetWTR) <- seq(-35, 145, by = 20) WTRAnchor <- apply(dummysheetWTR, 1, wtrcal) if(NA%in%WTRAnchor){ WTRTotal<-NA }else{ WTRTotal<-mean(WTRAnchor) } Caulperson <- matrix(c(WTRAnchor,WTRTotal), ncol = 7) Caulsum <- rbind(Caulsum,Caulperson) participantnumber<-participantnumber+1 } Caulsum<-as.data.frame(Caulsum) Caulsum<-round(Caulsum, digits = 3) Caulsum<-mutate(Caulsum,dummy=c(1:nrow(Caulsum))) rawCC<-mutate(rawCC,dummy=c(1:nrow(Caulsum))) Caulsum<-merge.data.frame(Caulsum,rawCC,by=‘dummy’) rawCombine<-mutate(as.data.frame(data_2[,c(2:8,36:44)]),dummy=c(1:nrow(data_2))) Finaldata_2<-merge.data.frame(Caulsum,rawCombine,by=‘dummy’) Finaldata_2<-as.data.frame(filter(Finaldata_2, sex!=3)) Finaldata_2<-Finaldata_2[complete.cases(Finaldata_2$WTRTOTAL),] Finaldata_2<-mutate(Finaldata_2,CC=unname(rowMeans(select(Finaldata_2,comf1:comf10)))) plot_2 = ggplot(Finaldata_2, aes(WTRTOTAL, CC)) + geom_point() + geom_smooth(aes(group = target_category), method = ‘lm’) + geom_smooth(method = ‘lm’) print(plot_2)

Plot Figure 2 for Study 3

rawCC<-data_3[,27:36] rawCC<-as.data.frame(as.matrix(rawCC)-4) part_sex<-ifelse(data_3\(Target<20.5,yes =1,no=2) part_att<-ifelse(data_3\)Target<20.5,yes = data_3\(Target,no=data_3\)Target-20) rawWTR_3<-data_3[,c(47:38,57:48,67:58)] rawWTR_3\('75_-26'[which(rawWTR_3\)’75_-26’==-.45)]<-0 rawWTR_3\('19_-7'[which(rawWTR_3\)’19_-7’==-.45)]<-0 rawWTR_3\('46_-16'[which(rawWTR_3\)’46_-16’==-.45)]<-0 rawWTRdummy<-as.matrix(rawWTR_3) rawWTRdummy[rawWTRdummy!=0]<-1 rawWTR_3<-as.data.frame(rawWTRdummy) rm(rawWTRdummy) participantnumber <- 1 Caulsum <- matrix(,,ncol=5) Caulsum <- Caulsum[-1,] colnames(Caulsum) <- c(“WTR75”,“WTR19”,“WTR46”,“WTRTOTAL”,‘DS’) wtrcal <- function(rawWTR) { rawWTR <- as.numeric(rawWTR) m <- seq(-35, 145, by = 20) if (sum(rawWTR) == 10) { anchorWTR = 1.55 } else if (sum(rawWTR) == 0){ anchorWTR = -0.45 } else { shiftcount = 0 shiftpoint = 0 for (i in 1:9) { if ((rawWTR[i] - rawWTR[i + 1]) == 1) { shiftcount = shiftcount + 1 shiftpoint <- (m[i] + m[i + 1])/2 + shiftpoint } } if (shiftcount > 2) { anchorWTR = NA } else { anchorWTR <- 0.01*shiftpoint/shiftcount } } } while (participantnumber <= nrow(data_3)) { dumx <- rawWTR_3[participantnumber,] dummysheetWTR <- matrix(data = dumx, ncol = 10, byrow = TRUE) colnames(dummysheetWTR) <- seq(-35, 145, by = 20) WTRAnchor <- apply(dummysheetWTR, 1, wtrcal) if(NA%in%WTRAnchor){ WTRTotal<-NA }else{ WTRTotal<-mean(WTRAnchor) } Caulperson <- matrix(c(WTRAnchor,WTRTotal), ncol = 5) Caulsum <- rbind(Caulsum,Caulperson) participantnumber<-participantnumber+1 } Caulsum<-as.data.frame(Caulsum) Caulsum<-round(Caulsum, digits = 3) Caulsum<-mutate(Caulsum,dummy=c(1:nrow(Caulsum))) rawCC<-mutate(rawCC,dummy=c(1:nrow(Caulsum))) Caulsum<-merge.data.frame(Caulsum,rawCC,by=‘dummy’) Finaldata_3<-mutate(Caulsum,sex=data_3\(sex,age=data_3\)age,value=data_3\(Value,part_sex,part_att,faces=data_3\)Target) Finaldata_3<-as.data.frame(filter(Finaldata_3, sex!=3)) Finaldata_3<-Finaldata_3[complete.cases(Finaldata_3$WTRTOTAL),] Finaldata_3<-mutate(Finaldata_3,CC=unname(rowMeans(select(Finaldata_3,comf1:comf10)))) plot_3 = ggplot(Finaldata_3, aes(WTRTOTAL, CC)) + geom_point() + geom_smooth(aes(group = value), method = ‘lm’) + geom_smooth(method = ‘lm’)

print(plot_3)

Stitch the plots together

plot_1 + plot_2 + plot_3

The console code:

#Complex scatter plots with regression line

#Plot figure 2 Data 1

data_1 = read_csv(‘WTR_Comfort_S1.csv’)

── Column specification ────────────────────────────────────────────────────────────────────────────────────────────────── cols( .default = col_double() ) ℹ Use spec() for the full column specifications.

data_1<-filter(data_1,English_exclude==0)

rawCC<-data_1[,30:39] rawCC<-as.data.frame(as.matrix(rawCC)-4)

rawWTR_1<-data_1[,c(49:40,59:50,69:60,79:70,89:80,99:90)] rawWTR_1\('37_-13'[which(rawWTR_1\)’37_-13’==-.45)]<-0 rawWTR_1\('23_-8'[which(rawWTR_1\)’23_-8’==-.45)]<-0 rawWTR_1\('75_-26'[which(rawWTR_1\)’75_-26’==-.45)]<-0 rawWTR_1\('19_-7'[which(rawWTR_1\)’19_-7’==-.45)]<-0 rawWTR_1\('46_-16'[which(rawWTR_1\)’46_-16’==-.45)]<-0 rawWTR_1\('68_-24'[which(rawWTR_1\)’68_-24’==-.45)]<-0 rawWTRdummy<-as.matrix(rawWTR_1) rawWTRdummy[rawWTRdummy!=0]<-1 rawWTR_1<-as.data.frame(rawWTRdummy) rm(rawWTRdummy) participantnumber <- 1 Caulsum <- matrix(,,ncol=9) Caulsum <- Caulsum[-1,] colnames(Caulsum) <- c(“WTR37”,“WTR23”,“WTR75”,“WTR19”,“WTR46”,“WTR68”,“WTRTOTAL”,‘DS’,‘HH’) wtrcal <- function(rawWTR) { + rawWTR <- as.numeric(rawWTR) + m <- seq(-35, 145, by = 20) + if(sum(rawWTR) == 10){ + anchorWTR = 1.55 + }else if(sum(rawWTR) == 0){ + anchorWTR = -0.45 + }else{ + shiftcount = 0 + shiftpoint = 0 + for(i in 1:9){ + if((rawWTR[i] - rawWTR[i + 1]) == 1){ + shiftcount = shiftcount + 1 + shiftpoint <- (m[i] + m[i + 1])/2 + shiftpoint + } + } + if (shiftcount > 2) { + anchorWTR = NA + } else { + anchorWTR <- 0.01*shiftpoint/shiftcount + } + } + } while (participantnumber <= nrow(data_1)) { + dumx <- rawWTR_1[participantnumber,] + dummysheetWTR <- matrix(data = dumx, ncol = 10, byrow = TRUE) + colnames(dummysheetWTR) <- seq(-35, 145, by = 20) + WTRAnchor <- apply(dummysheetWTR, 1, wtrcal) + if(NA%in%WTRAnchor){ + WTRTotal<-NA + }else{ + WTRTotal<-mean(WTRAnchor) + } + Caulperson <- matrix(c(WTRAnchor,WTRTotal), ncol = 9) + Caulsum <- rbind(Caulsum,Caulperson) + participantnumber<-participantnumber+1 + } There were 50 or more warnings (use warnings() to see the first 50) Caulsum<-as.data.frame(Caulsum) Caulsum<-round(Caulsum, digits = 3) Caulsum<-mutate(Caulsum,dummy=c(1:501)) rawCC<-mutate(rawCC,dummy=c(1:501)) Caulsum<-merge.data.frame(Caulsum,rawCC,by=‘dummy’) Finaldata_1<-as.data.frame(filter(mutate(Caulsum,sex=data_1\(sex,age=data_1\)age,part_sex=data_1\(part_sex,relation=data_1\)relationship_category, + income=data_1\(income,part_age=data_1\)part_age,part_leng=data_1\(part_leng,spa=data_1\)poli_soc,epa=data_1\(poli_econ, + trust=data_1\)trust_gen), sex!=3)) Finaldata_1<-Finaldata_1[complete.cases(Finaldata_1$WTRTOTAL),] Finaldata_1<-mutate(Finaldata_1,CC=unname(rowMeans(select(Finaldata_1,comf1:comf10)))) plot_1 = ggplot(Finaldata_1, aes(WTRTOTAL, CC)) + + geom_point() + + geom_smooth(aes(group = relation), method = ‘lm’) + + geom_smooth(method = ‘lm’) print(plot_1) geom_smooth() using formula ‘y ~ x’ geom_smooth() using formula ‘y ~ x’ Warning messages: 1: Removed 3 rows containing non-finite values (stat_smooth). 2: Removed 3 rows containing non-finite values (stat_smooth). 3: Removed 3 rows containing missing values (geom_point).

#Plot figure 2 Data 2

data_2 = read_csv(‘WTR_Comfort_S2.csv’)

── Column specification ────────────────────────────────────────────────────────────────────────────────────────────────── cols( .default = col_double() ) ℹ Use spec() for the full column specifications.

data_2<-filter(data_2,English_exclude==0) rawCC<-data_2[,45:54] rawCC<-as.data.frame(as.matrix(rawCC)-4) rawWTR_2<-data_2[,c(64:55,74:65,84:75)] rawWTR_2\('75_-26'[which(rawWTR_2\)’75_-26’==-.45)]<-0 rawWTR_2\('19_-7'[which(rawWTR_2\)’19_-7’==-.45)]<-0 rawWTR_2\('46_-16'[which(rawWTR_2\)’46_-16’==-.45)]<-0 rawWTRdummy<-as.matrix(rawWTR_2) rawWTRdummy[rawWTRdummy!=0]<-1 rawWTR_2<-as.data.frame(rawWTRdummy) rm(rawWTRdummy) participantnumber <- 1 Caulsum <- matrix(,,ncol=7) Caulsum <- Caulsum[-1,] colnames(Caulsum) <- c(“WTR75”,“WTR19”,“WTR46”,“WTRTOTAL”,‘DS’,‘HH’,‘AG’) wtrcal <- function(rawWTR) { + rawWTR <- as.numeric(rawWTR) + m <- seq(-35, 145, by = 20) + if(sum(rawWTR) == 10){ + anchorWTR = 1.55 + }else if(sum(rawWTR) == 0){ + anchorWTR = -0.45 + }else{ + shiftcount = 0 + shiftpoint = 0 + for(i in 1:9){ + if((rawWTR[i] - rawWTR[i + 1]) == 1){ + shiftcount = shiftcount + 1 + shiftpoint <- (m[i] + m[i + 1])/2 + shiftpoint + } + } + if (shiftcount > 2) { + anchorWTR = NA + } else { + anchorWTR <- 0.01*shiftpoint/shiftcount + } + } + } while (participantnumber <= nrow(data_2)) { + dumx <- rawWTR_2[participantnumber,] + dummysheetWTR <- matrix(data = dumx, ncol = 10, byrow = TRUE) + colnames(dummysheetWTR) <- seq(-35, 145, by = 20) + WTRAnchor <- apply(dummysheetWTR, 1, wtrcal) + if(NA%in%WTRAnchor){ + WTRTotal<-NA + }else{ + WTRTotal<-mean(WTRAnchor) + } + Caulperson <- matrix(c(WTRAnchor,WTRTotal), ncol = 7) + Caulsum <- rbind(Caulsum,Caulperson) + participantnumber<-participantnumber+1 + } There were 50 or more warnings (use warnings() to see the first 50) Caulsum<-as.data.frame(Caulsum) Caulsum<-round(Caulsum, digits = 3) Caulsum<-mutate(Caulsum,dummy=c(1:nrow(Caulsum))) rawCC<-mutate(rawCC,dummy=c(1:nrow(Caulsum))) Caulsum<-merge.data.frame(Caulsum,rawCC,by=‘dummy’) rawCombine<-mutate(as.data.frame(data_2[,c(2:8,36:44)]),dummy=c(1:nrow(data_2))) Finaldata_2<-merge.data.frame(Caulsum,rawCombine,by=‘dummy’) Finaldata_2<-as.data.frame(filter(Finaldata_2, sex!=3)) Finaldata_2<-Finaldata_2[complete.cases(Finaldata_2$WTRTOTAL),] Finaldata_2<-mutate(Finaldata_2,CC=unname(rowMeans(select(Finaldata_2,comf1:comf10)))) plot_2 = ggplot(Finaldata_2, aes(WTRTOTAL, CC)) + + geom_point() + + geom_smooth(aes(group = target_category), method = ‘lm’) + + geom_smooth(method = ‘lm’) print(plot_2) geom_smooth() using formula ‘y ~ x’ geom_smooth() using formula ‘y ~ x’ Warning messages: 1: Removed 3 rows containing non-finite values (stat_smooth). 2: Removed 3 rows containing non-finite values (stat_smooth). 3: Removed 3 rows containing missing values (geom_point).

#Plot figure 2 for study 3

rawCC<-data_3[,27:36] rawCC<-as.data.frame(as.matrix(rawCC)-4) part_sex<-ifelse(data_3\(Target<20.5,yes =1,no=2) part_att<-ifelse(data_3\)Target<20.5,yes = data_3\(Target,no=data_3\)Target-20) rawWTR_3<-data_3[,c(47:38,57:48,67:58)] rawWTR_3\('75_-26'[which(rawWTR_3\)’75_-26’==-.45)]<-0 rawWTR_3\('19_-7'[which(rawWTR_3\)’19_-7’==-.45)]<-0 rawWTR_3\('46_-16'[which(rawWTR_3\)’46_-16’==-.45)]<-0 rawWTRdummy<-as.matrix(rawWTR_3) rawWTRdummy[rawWTRdummy!=0]<-1 rawWTR_3<-as.data.frame(rawWTRdummy) rm(rawWTRdummy) participantnumber <- 1 Caulsum <- matrix(,,ncol=5) Caulsum <- Caulsum[-1,] colnames(Caulsum) <- c(“WTR75”,“WTR19”,“WTR46”,“WTRTOTAL”,‘DS’) wtrcal <- function(rawWTR) { + rawWTR <- as.numeric(rawWTR) + m <- seq(-35, 145, by = 20) + if (sum(rawWTR) == 10) { + anchorWTR = 1.55 + } else if (sum(rawWTR) == 0){ + anchorWTR = -0.45 + } else { + shiftcount = 0 + shiftpoint = 0 + for (i in 1:9) { + if ((rawWTR[i] - rawWTR[i + 1]) == 1) { + shiftcount = shiftcount + 1 + shiftpoint <- (m[i] + m[i + 1])/2 + shiftpoint + } + } + if (shiftcount > 2) { + anchorWTR = NA + } else { + anchorWTR <- 0.01*shiftpoint/shiftcount + } + } + } while (participantnumber <= nrow(data_3)) { + dumx <- rawWTR_3[participantnumber,] + dummysheetWTR <- matrix(data = dumx, ncol = 10, byrow = TRUE) + colnames(dummysheetWTR) <- seq(-35, 145, by = 20) + WTRAnchor <- apply(dummysheetWTR, 1, wtrcal) + if(NA%in%WTRAnchor){ + WTRTotal<-NA + }else{ + WTRTotal<-mean(WTRAnchor) + } + Caulperson <- matrix(c(WTRAnchor,WTRTotal), ncol = 5) + Caulsum <- rbind(Caulsum,Caulperson) + participantnumber<-participantnumber+1 + } There were 50 or more warnings (use warnings() to see the first 50) Caulsum<-as.data.frame(Caulsum) Caulsum<-round(Caulsum, digits = 3) Caulsum<-mutate(Caulsum,dummy=c(1:nrow(Caulsum))) rawCC<-mutate(rawCC,dummy=c(1:nrow(Caulsum))) Caulsum<-merge.data.frame(Caulsum,rawCC,by=‘dummy’) Finaldata_3<-mutate(Caulsum,sex=data_3\(sex,age=data_3\)age,value=data_3\(Value,part_sex,part_att,faces=data_3\)Target) Finaldata_3<-as.data.frame(filter(Finaldata_3, sex!=3)) Finaldata_3<-Finaldata_3[complete.cases(Finaldata_3$WTRTOTAL),] Finaldata_3<-mutate(Finaldata_3,CC=unname(rowMeans(select(Finaldata_3,comf1:comf10)))) plot_3 = ggplot(Finaldata_3, aes(WTRTOTAL, CC)) + + geom_point() + + geom_smooth(aes(group = value), method = ‘lm’) + + geom_smooth(method = ‘lm’)

print(plot_3) geom_smooth() using formula ‘y ~ x’ geom_smooth() using formula ‘y ~ x’ Warning messages: 1: Removed 5 rows containing non-finite values (stat_smooth). 2: Removed 5 rows containing non-finite values (stat_smooth). 3: Removed 5 rows containing missing values (geom_point).

#Stitch the plots together

plot_1 + plot_2 + plot_3 geom_smooth() using formula ‘y ~ x’ geom_smooth() using formula ‘y ~ x’ geom_smooth() using formula ‘y ~ x’ geom_smooth() using formula ‘y ~ x’ geom_smooth() using formula ‘y ~ x’ geom_smooth() using formula ‘y ~ x’ Warning messages: 1: Removed 3 rows containing non-finite values (stat_smooth). 2: Removed 3 rows containing non-finite values (stat_smooth). 3: Removed 3 rows containing missing values (geom_point). 4: Removed 3 rows containing non-finite values (stat_smooth). 5: Removed 3 rows containing non-finite values (stat_smooth). 6: Removed 3 rows containing missing values (geom_point). 7: Removed 5 rows containing non-finite values (stat_smooth). 8: Removed 5 rows containing non-finite values (stat_smooth). 9: Removed 5 rows containing missing values (geom_point).

Our plots vs. The article plots

Ours:

Tybur et al. (2020)

Challenges & Successes

• For the descriptive statistics, I understand all of the code and what it’s doing.
• For the violin plots, I understand most of the code and what it’s doing.
• For the complex scatter plots, I understand almost none of the code or what it’s doing.
• At the beginning of the week, I didn’t even know how to write code for descriptive statistics. Luckily I’ve got an amazingly supportive group who walked me through this and gave me some confidence.
• A success for me this week was plotting the violin plots for each study and then patching them together so that they look almost exactly like those in our article.
  • Google was my best friend!
  • For something that looks relatively simple, and would be on the processing systems I’m used to, it was very difficult to find the right code, even with the help of Google, and to apply this code to our code!
• I’ve still got a few questions though.
  • How do I remove the y-axis from the study 2 plot, not just the study 3 plot?
  • How do I add the dashed line between the 3 plots?
  • Not yet a question, but a task for this week is to add colour, a title, and a legend to the complex figure 2 plots, as well as position them in the same way as the article?
• Carla Pham will be posting our (Group 3) questions for the Q&A this week.

Goals for this week

• Apart from trying to code the aesthetics for the plots this week, I would like to be able to go through the code and write comments for each of the code, like I’ve done for the descriptive statistics, to understand exactly what is going on so that I can repeat it down the track if I ever need to.