Neural and behavioural correlates of theory of mind reasoning in five-year-old children born preterm.

Code ↔ Paper

12 matches between paragraphs of the paper and lines of its authors' code, computed by the harvester (lexical-v1). Click a colored paragraph or line to see its counterpart.

The 12 matches

[1] § Methods › fMRI data analyses ↔ scripts/05.motion_exclusions/mark_motion_exclusions.py, lines 142–217 · score 0.83 · composite motion, framewise displacement, standardised DVARS, artifact timepoints, rapidart, FD
[2] § Methods › fMRI data analyses › Whole-brain random effects analyses ↔ scripts/07.second_level/secondlevel_pipeline.py, lines 344–391 · score 0.73 · threshold free cluster, FSL, enhancement, RANDOMISE, nonparametric, TFCE
[3] § Methods › Measures › Other cognitive measures and covariates ↔ Data and Code/Abeletal_PTB-ToM_dosedependency.R, lines 142–190 · score 0.69 · executive functions, percentile rank, gestational age, siblings, covariates, language
[4] § Methods › fMRI data analyses ↔ scripts/06.first_level/firstlevel_pipeline.py, lines 858–997 · score 0.67 · MNI152NLin2009cAsym, fMRIPrep, T1w, kernel, pipeline, smoothed
[5] § Methods › fMRI data analyses ↔ scripts/06.first_level/timecourse_pipeline.py, lines 297–338 · score 0.66 · framewise displacement, aCompCor, DVARS, confound, pipeline, MNI
[6] § Methods › Measures › Other cognitive measures and covariates ↔ Data and Code/Abeletal_PTB-ToM_mainAnalyses.R, lines 561–647 · score 0.65 · Receptive language, forced choice, percentile rank, boxplot, booklet, violin
[7] § Methods › fMRI data analyses › First-level modelling ↔ scripts/07.second_level/reverse_correlation.py, lines 1–21 · score 0.63 · Reverse correlation, timecourses extracted, HRF, timepoints, movie, event
[8] § Methods › Measures › Other cognitive measures and covariates ↔ Data and Code/Abeletal_PTB-ToM_mainAnalyses.R, lines 561–647 · score 0.59 · receptive language, percentile rank, gestational age, score, GA
[9] § Methods › fMRI data analyses › Regions of interest (ROI) analyses ↔ scripts/07.second_level/reverse_correlation.py, lines 104–174 · score 0.59 · reverse correlation, events identified, peak, longer, timepoints, magnitude
[10] § Methods › fMRI data analyses ↔ Data and Code/Abeletal_PTB-ToM_dosedependency.R, lines 320–371 · score 0.55 · framewise displacement, Cohen, DVARS, SD, artifact, FD
[11] § Results › Movie-viewing fMRI results › Regions of interest analyses ↔ Data and Code/Abeletal_PTB-ToM_mainAnalyses.R, lines 792–831 · score 0.54 · functional maturity, gestational age, response magnitude, network, GA, preterm
[12] § Methods › fMRI data analyses › Regions of interest (ROI) analyses ↔ scripts/06.first_level/calc_psc.py, lines 122–160 · score 0.51 · artifact timepoint, high pass filtered, TR, volumes, Motion

Paper

Loaded from Europe PMC by your browser, not stored by OSCR: doi.org · Europe PMC

The paper is loaded when this pane is shown.

The paper is loaded by your browser, with JavaScript: read it at doi.org or on Europe PMC.

The authors' code

R · 1,484 lines · 79 KB · no license · 3 matches

#requires Abeletal_Data, TEBC_TC, and TEBC_timeshift_IRC to have been run
#setwd
library(tidyverse)
library("ggplot2")
library("ggExtra")
library(tiff)
library(lmerTest)
library(lme4)
library(patchwork)
library(purrr)
Abeletal_Data <- read.csv("./Data/Abeletal_PTB-ToM_Data.csv")
sink(paste0("./PTB_results_", Sys.Date(), ".txt"))
print("#Descriptives")
print("##get averages, min, max GA for Pt and T groups
Behavioural kids")
Behavioural_kids <- Abeletal_Data %>% filter(!is.na(T_ToM_Score) & T_ToM_Score != "")
Behavioural_kids %>%
group_by(Preterm) %>%
summarise_at(vars(GA_birth), list(min, max, mean, sd), na.rm=T)
Behavioural_kids %>%
group_by(Preterm) %>%
summarise(min_age = min(T_age, na.rm = TRUE),
max_age = max(T_age, na.rm = TRUE),
mean_age = mean(T_age, na.rm = TRUE),
SD_age = sd(T_age, na.rm = TRUE)
)
Behavioural_kids %>%
group_by(Preterm) %>%
summarize(count = n())
Behavioural_kids %>% count(Sex, Preterm)
print("all kids")
Abeletal_Data %>%
group_by(Preterm) %>%
summarise_at(vars(GA_birth), list(min, max, mean, sd), na.rm=T)
Abeletal_Data %>%
group_by(Preterm) %>%
summarise(min_age = min(T_age, na.rm = TRUE),
max_age = max(T_age, na.rm = TRUE),
mean_age = mean(T_age, na.rm = TRUE),
SD_age = sd(T_age, na.rm = TRUE)
)
Abeletal_Data %>%
group_by(Preterm) %>%
summarize(count = n())
Abeletal_Data %>% count(Sex, Preterm)
#---------------------------------------
print("##Calculate descriptive statistics (M (Se)) of proportion of test items answered correctly, per group [children born preterm and at term]). ")
variables <- c("C_ToM_Score", "AF_ToM_Score", "E_ToM_Score", "T_ToM_Score", "DD_ToM_Score", "RL_PercentileRank")
data_summary <- map_dfr(variables, function(var) {
Abeletal_Data %>%
group_by(Preterm) %>%
summarise(
Variable = var,
Mean = mean(.data[[var]], na.rm = TRUE),
SE = sd(.data[[var]], na.rm = TRUE) / sqrt(n())
)
})
print(data_summary)
print("##Does performance on ToM task differ as a function of GA, controlling for test age? ")
summary(lm(T_ToM_Score ~ scale(GA_birth) + scale(T_age), data = Abeletal_Data))
summary(lm(AF_ToM_Score ~ scale(GA_birth) + scale(T_age), data = Abeletal_Data))
summary(lm(E_ToM_Score ~ scale(GA_birth) + scale(T_age), data = Abeletal_Data))
#summary(lm(C_ToM_Score ~ scale(GA_birth) + scale(T_age), data = Abeletal_Data))
#summary(lm(DD_ToM_Score ~ scale(GA_birth) + scale(T_age), data = Abeletal_Data))
cor.test(Abeletal_Data$DD_ToM_Score, Abeletal_Data$GA_birth, use = "complete.obs")
correlation_DD_ToM <- cor(Abeletal_Data$DD_ToM_Score, Abeletal_Data$GA_birth, use = "complete.obs")
r_squared <- correlation_DD_ToM^2
cohen_d <- 2 * correlation_DD_ToM / sqrt(1 - correlation_DD_ToM^2)
fisher_z <- 0.5 * log((1 + correlation_DD_ToM) / (1 - correlation_DD_ToM))
list(correlation_DD_ToM = correlation_DD_ToM, r_squared = r_squared, cohen_d = cohen_d, fisher_z = fisher_z)
cor.test(Abeletal_Data$DD_ToM_Score, Abeletal_Data$T_ToM_Score, use = "complete.obs")
#summary(lm(FB_ToM_Score ~ scale(GA_birth) + scale(T_age), data = Abeletal_Data))
#Including interaction term
##Does performance on ToM task differ as a function of GA, controlling for test age? "
#summary(lm(T_ToM_Score ~ scale(GA_birth) * scale(T_age), data = Abeletal_Data))
#summary(lm(AF_ToM_Score ~ scale(GA_birth) * scale(T_age), data = Abeletal_Data))
#summary(lm(E_ToM_Score ~ scale(GA_birth) * scale(T_age), data = Abeletal_Data))
#summary(lm(C_ToM_Score ~ scale(GA_birth) * scale(T_age), data = Abeletal_Data))
#summary(lm(DD_ToM_Score ~ scale(GA_birth) * scale(T_age), data = Abeletal_Data))
summary(lm(FB_ToM_Score ~ scale(GA_birth) + scale(T_age), data = Abeletal_Data))
print("#Additional - nSibs")
summary(lm(T_ToM_Score ~ scale(num_sibs) + scale(GA_birth) + scale(T_age), data = Abeletal_Data))
summary(lm(T_ToM_Score ~ scale(num_sibs) + scale(T_age), data = Abeletal_Data))
print("#If GA predicts ToM performance: Does performance on ToM task differ as a function of GA, controlling for other covariates impacted by/related to GA? ")
print("#First, we will test whether language, executive functions, attention, and number of siblings correlate with gestational age:")
summary(lm(Abeletal_Data$RL_PercentileRank ~ scale(Abeletal_Data$GA_birth) + scale(Abeletal_Data$T_age)))
summary(lm(Abeletal_Data$Inattention ~ scale(Abeletal_Data$GA_birth) + scale(Abeletal_Data$T_age)))
summary(lm(Abeletal_Data$ECITT_accd ~ scale(Abeletal_Data$GA_birth) + scale(Abeletal_Data$T_age)))
summary(lm(Abeletal_Data$num_sibs ~ scale(Abeletal_Data$GA_birth) + scale(Abeletal_Data$T_age)))
Sub_Abeletal_Data <- subset(Abeletal_Data, select = c(Sub, num_sibs, GA_birth, Preterm, T_age, T_ToM_Score, RL_PercentileRank))
Sub_Abeletal_Data <- Sub_Abeletal_Data[!(Sub_Abeletal_Data$num_sibs %in% "4"),]
summary(lm(Sub_Abeletal_Data$num_sibs ~ scale(Sub_Abeletal_Data$GA_birth) + scale(Sub_Abeletal_Data$T_age)))
summary(lm(Sub_Abeletal_Data$T_ToM_Score ~ scale(Sub_Abeletal_Data$num_sibs) + scale(Sub_Abeletal_Data$GA_birth) + scale(Sub_Abeletal_Data$T_age) + scale(Sub_Abeletal_Data$RL_PercentileRank)))
summary(lm(Sub_Abeletal_Data$T_ToM_Score ~ scale(Sub_Abeletal_Data$num_sibs) + scale(Sub_Abeletal_Data$GA_birth) + scale(Sub_Abeletal_Data$T_age)))
summary(lm(Sub_Abeletal_Data$T_ToM_Score ~ scale(Sub_Abeletal_Data$num_sibs) + scale(Sub_Abeletal_Data$T_age)))
print("#Abeletal_Data")
Abeletal_Data %>%
group_by(Preterm) %>%
summarise(mean_sibs = mean(num_sibs, na.rm = TRUE),
SD_sibs = sd(num_sibs, na.rm = TRUE)
)
print("#Sub_Abeletal_Data")
Sub_Abeletal_Data %>%
group_by(Preterm) %>%
summarise(mean_sibs = mean(num_sibs, na.rm = TRUE),
SD_sibs = sd(num_sibs, na.rm = TRUE)
)
print("#Next, we will repeat the analysis testing for an impact of gestational age on ToM, controlling for the other covariates that correlate with GA: ")
summary(lm(Abeletal_Data$T_ToM_Score ~ scale(Abeletal_Data$GA_birth) + scale(Abeletal_Data$T_age) + scale(Abeletal_Data$RL_PercentileRank) +scale(Abeletal_Data$ECITT_accd) + scale(Abeletal_Data$Inattention))) #+ scale(Abeletal_Data$num_sibs)))
summary(lm(Abeletal_Data$T_ToM_Score ~ scale(Abeletal_Data$num_sibs) + scale(Abeletal_Data$GA_birth) + scale(Abeletal_Data$T_age) + scale(Abeletal_Data$RL_PercentileRank)))
summary(lm(Abeletal_Data$T_ToM_Score ~ scale(Abeletal_Data$GA_birth) + scale(Abeletal_Data$T_age) + scale(Abeletal_Data$RL_PercentileRank)))
summary(lm(Abeletal_Data$AF_ToM_Score ~ scale(Abeletal_Data$GA_birth) + scale(Abeletal_Data$T_age) + scale(Abeletal_Data$RL_PercentileRank))) # + scale(Abeletal_Data$num_sibs)))
summary(lm(Abeletal_Data$E_ToM_Score ~ scale(Abeletal_Data$GA_birth) + scale(Abeletal_Data$T_age) + scale(Abeletal_Data$RL_PercentileRank))) # + scale(Abeletal_Data$num_sibs)))
#summary(lm(Abeletal_Data$DD_ToM_Score ~ scale(Abeletal_Data$GA_birth) + scale(Abeletal_Data$T_age) + scale(Abeletal_Data$RL_PercentileRank))) # + scale(Abeletal_Data$num_sibs)))
summary(lm(Abeletal_Data$FB_ToM_Score ~ scale(Abeletal_Data$GA_birth) + scale(Abeletal_Data$T_age) + scale(Abeletal_Data$RL_PercentileRank))) # + scale(Abeletal_Data$num_sibs)))
Item_type_long_data <- Abeletal_Data %>%
pivot_longer(
cols = AF_ToM_Score:E_ToM_Score, # Columns to pivot
names_to = "Item_type", # New column for the variable names
values_to = "Performance" # New column for the values
)
class(Item_type_long_data$Performance)
#Difficulty_long_data$Performance <- as.numeric(as.character(Difficulty_long_data$Performance))
#view(Difficulty_long_data)
Item_type_long_data <- Item_type_long_data %>% filter(!is.na(FB_ToM_Score) & FB_ToM_Score != "")
Item_type_long_data <- Item_type_long_data %>%
mutate(Item_type = case_when(Item_type == "AF_ToM_Score" ~ "Forced choice",
Item_type == "E_ToM_Score" ~ "Free response"))
Item_type_long_data$Item_type <- factor(
Item_type_long_data$Item_type,
levels = c("Forced choice", "Free response")
)
TEBC_ToM_Item_type <- lmerTest::lmer(Performance ~ scale(GA_birth) * Item_type + scale(T_age) + scale(RL_PercentileRank) + (1 | Sub), data = Item_type_long_data) #+ scale(num_sibs)
summary(TEBC_ToM_Item_type)
print("##ADDITIONAL")
print("#splitting beh data in easier and harder items")
# for each child score per sub-cat and column (GA/TA/Difficulty/Score)
# Pivot from wide to long format
Difficulty_long_data <- Abeletal_Data %>%
pivot_longer(
cols = Easy_ToM_Score:Hard_ToM_Score, # Columns to pivot
names_to = "Difficulty", # New column for the variable names
values_to = "Performance" # New column for the values
)
class(Difficulty_long_data$Performance)
#Difficulty_long_data$Performance <- as.numeric(as.character(Difficulty_long_data$Performance))
#view(Difficulty_long_data)
Difficulty_long_data <- Difficulty_long_data %>% filter(!is.na(T_ToM_Score) & T_ToM_Score != "")
TEBC_ToM_Difficulty <- lmerTest::lmer(Performance ~ scale(GA_birth) + Difficulty + scale(T_age) + scale(RL_PercentileRank) + (1 | Sub), data = Difficulty_long_data) #+ scale(num_sibs)
summary(TEBC_ToM_Difficulty)
Difficulty_long_data <- Difficulty_long_data %>%
mutate(Difficulty = case_when(Difficulty == "Easy_ToM_Score" ~ "Easy",
Difficulty == "FB_ToM_Score" ~ "FB",
Difficulty == "Hard_ToM_Score" ~ "Hard"))
Difficulty_long_data$Difficulty <- factor(
Difficulty_long_data$Difficulty,
levels = c("Easy", "FB", "Hard")
)
print("##Neuro data")
print("#ToM only children with useable fMRI data")
fMRI_kids <- Abeletal_Data %>% filter(task == "pixar")
fMRI_kids %>%
group_by(Preterm) %>%
summarise_at(vars(GA_birth), list(name = mean), na.rm=T)
fMRI_kids %>%
group_by(Preterm) %>%
summarise_at(vars(GA_birth), list(min, max), na.rm=T)
fMRI_kids %>%
group_by(Preterm) %>%
summarise(min_age = min(T_age, na.rm = TRUE),
max_age = max(T_age, na.rm = TRUE),
mean_age = mean(T_age, na.rm = TRUE))
fMRI_kids %>%
group_by(Preterm) %>%
summarize(count = n())
fMRI_kids %>% count(Sex, Preterm)
fMRI_kids %>%
summarise(
mean_value = mean(T_age, na.rm = TRUE),
sd_value = sd(T_age, na.rm = TRUE)
)
summary(lm(fMRI_kids$ECITT_accd ~ scale(fMRI_kids$GA_birth) + scale(fMRI_kids$T_age)))
summary(lm(fMRI_kids$RL_PercentileRank ~ scale(fMRI_kids$GA_birth) + scale(fMRI_kids$T_age)))
summary(lm(fMRI_kids$Inattention ~ scale(fMRI_kids$GA_birth) + scale(fMRI_kids$T_age)))
summary(lm(T_ToM_Score ~ scale(GA_birth) + scale(T_age), data = fMRI_kids))
summary(lm(T_ToM_Score ~ scale(GA_birth) + scale(T_age) + scale(RL_PercentileRank), data = fMRI_kids)) #+ scale(num_sibs)
Item_type_long_data <- fMRI_kids %>%
pivot_longer(
cols = AF_ToM_Score:E_ToM_Score, # Columns to pivot
names_to = "Item_type", # New column for the variable names
values_to = "Performance" # New column for the values
)
class(Item_type_long_data$Performance)
#Difficulty_long_data$Performance <- as.numeric(as.character(Difficulty_long_data$Performance))
#view(Difficulty_long_data)
Item_type_long_data <- Item_type_long_data %>% filter(!is.na(FB_ToM_Score) & FB_ToM_Score != "")
Item_type_long_data <- Item_type_long_data %>%
mutate(Item_type = case_when(Item_type == "AF_ToM_Score" ~ "Forced choice",
Item_type == "E_ToM_Score" ~ "Free response"))
Item_type_long_data$Item_type <- factor(
Item_type_long_data$Item_type,
levels = c("Forced choice", "Free response")
)
TEBC_ToM_Item_type <- lmerTest::lmer(Performance ~ scale(GA_birth) * Item_type + scale(T_age) + scale(RL_PercentileRank) + (1 | Sub), data = Item_type_long_data) #+ scale(num_sibs)
summary(TEBC_ToM_Item_type)
TEBC_ToM_Item_type <- lmerTest::lmer(Performance ~ scale(GA_birth) + Item_type + scale(T_age) + scale(RL_PercentileRank) + (1 | Sub), data = Item_type_long_data) #+ scale(num_sibs)
summary(TEBC_ToM_Item_type)
#Pixar Comp
std.error <- function(x) sd(x)/sqrt(length(x)) #define standard error of mean function
Abeletal_Data %>%
group_by(Preterm) %>%
summarize(
Pix_ToM_Mean = round(mean(Pix_ToM, na.rm = TRUE), 2),
Pix_ToM_SD = round(sd(Pix_ToM, na.rm = TRUE), 2),
Pix_Control_Mean = round(mean(Pix_Control, na.rm = TRUE), 2),
Pix_Control_SD = round(sd(Pix_Control, na.rm = TRUE), 2),
Pix_ToM_SE = ((sd(Pix_ToM, na.rm = T))/ sqrt(n())),
Pix_Control_SE = ((sd(Pix_Control, na.rm = T))/ sqrt(n()))
)
summary(lm(Pix_Control ~ scale(GA_birth) + scale(T_age), Abeletal_Data))
summary(lm(Pix_ToM ~ scale(GA_birth) + scale(T_age), Abeletal_Data))
summary(lm(Pix_Control ~ scale(GA_birth) + scale(T_age) + scale(RL_PercentileRank), Abeletal_Data))
summary(lm(Pix_ToM ~ scale(GA_birth) + scale(T_age) + scale(RL_PercentileRank), Abeletal_Data))
summary(lm(T_ToM_Score ~ scale(Pix_ToM) + scale(GA_birth) + scale(T_age) + scale(RL_PercentileRank), Abeletal_Data))
summary(lm(T_ToM_Score ~ scale(Pix_ToM) + scale(GA_birth) + scale(T_age), Abeletal_Data))
summary(lm(T_ToM_Score ~ scale(Pix_ToM) + scale(RL_PercentileRank) + scale(T_age), Abeletal_Data))
summary(lm(T_ToM_Score ~ scale(Pix_ToM) + scale(T_age), Abeletal_Data))
#Motion
Abeletal_Data$X.Artifacts_ART <- as.numeric(Abeletal_Data$X.Artifacts_ART)
Abeletal_Data %>%
group_by(Preterm) %>%
summarize(
Mean_MeanFD = mean(MeanFD, na.rm = TRUE),
MeanDVARS = mean(MeanDVARS, na.rm = TRUE),
MeanART = mean(X.Artifacts_ART, na.rm = TRUE))
Abeletal_Data %>%
group_by(Preterm) %>%
summarize(
SD_MeanFD = (sqrt(var(MeanFD, na.rm = TRUE))),
SD_DVARS = (sqrt(var(MeanDVARS, na.rm = TRUE))),
SD_ART = (sqrt(var(X.Artifacts_ART, na.rm = TRUE))))
#We will test for correlations between motion and GA, controlling for age, with (1) number of motion outliers and (2) average framewise displacemen
cor.test(Abeletal_Data$MeanFD, Abeletal_Data$GA_birth, use = "complete.obs")
correlation_MeanFD <- cor(Abeletal_Data$MeanFD, Abeletal_Data$GA_birth, use = "complete.obs")
r_squared <- correlation_MeanFD^2
cohen_d <- 2 * correlation_MeanFD / sqrt(1 - correlation_MeanFD^2)
fisher_z <- 0.5 * log((1 + correlation_MeanFD) / (1 - correlation_MeanFD))
list(correlation_MeanFD = correlation_MeanFD, r_squared = r_squared, cohen_d = cohen_d, fisher_z = fisher_z)
cor.test(Abeletal_Data$X.Artifacts_ART, Abeletal_Data$GA_birth, use = "complete.obs")
correlation_X.Artifacts_ART <- cor(Abeletal_Data$X.Artifacts_ART, Abeletal_Data$GA_birth, use = "complete.obs")
r_squared <- correlation_X.Artifacts_ART^2
cohen_d <- 2 * correlation_X.Artifacts_ART / sqrt(1 - correlation_X.Artifacts_ART^2)
fisher_z <- 0.5 * log((1 + correlation_X.Artifacts_ART) / (1 - correlation_X.Artifacts_ART))
list(correlation_X.Artifacts_ART = correlation_X.Artifacts_ART, r_squared = r_squared, cohen_d = cohen_d, fisher_z = fisher_z)
#FuncMat
#FuncMat_data <- read.csv("./EBC/Data/TEBC_other/FuncMat_Data.csv")
#ToM_Funcmat <- c("RTPJ_FuncMat", "LTPJ_FuncMat", "DMPFC_FuncMat", "VMPFC_FuncMat", "PC_FuncMat", "MMPFC_FuncMat")
#FuncMat_data <- FuncMat_data %>%
# mutate(ToM_FuncMat = rowMeans(select(., all_of(ToM_Funcmat))))
#Abeletal_Data <- merge(Abeletal_Data, FuncMat_data, by = "Sub", all.x = T)
Abeletal_Data %>%
group_by(Preterm) %>%
summarize(
ToM_FuncMat_Mean = round(mean(ToM_FuncMat, na.rm = TRUE), 2),
ToM_FuncMat_SD = round(sd(ToM_FuncMat, na.rm = TRUE), 2),
ToM_FuncMat_SE = ((sd(ToM_FuncMat, na.rm = T))/ sqrt(n())),
)
Abeletal_Data %>%
group_by(Preterm) %>%
summarize(
RTPJ_FuncMat_Mean = round(mean(RTPJ_FuncMat, na.rm = TRUE), 2),
RTPJ_FuncMat_SD = round(sd(RTPJ_FuncMat, na.rm = TRUE), 2),
RTPJ_FuncMat_SE = ((sd(RTPJ_FuncMat, na.rm = T))/ sqrt(n())),
)
summary(lm(RTPJ_FuncMat ~ scale(GA_birth) + scale(T_age) + scale(MeanFD) , data = Abeletal_Data)) #scale(GA_birth) * scale(T_age)
summary(lm(RTPJ_FuncMat ~ scale(num_sibs) + scale(GA_birth) + scale(T_age) + scale(MeanFD) , data = Abeletal_Data))
FuncMat_long_data <- Abeletal_Data %>% select(Sub, GA_birth, T_age, num_sibs, MeanFD, DMPFC_FuncMat, VMPFC_FuncMat, PC_FuncMat, MMPFC_FuncMat, LTPJ_FuncMat, RTPJ_FuncMat)
FuncMat_long_data <- FuncMat_long_data %>%
pivot_longer(
cols = DMPFC_FuncMat:RTPJ_FuncMat, # Columns to pivot
names_to = "ROI", # New column for the variable names
values_to = "FuncMat_ROI" # New column for the values
) %>%
filter(!is.na(MeanFD))
class(FuncMat_long_data$ROI)
FuncMat_long_data$ROI <- as.factor(FuncMat_long_data$ROI)
FuncMat_long_data$ROI <- relevel(FuncMat_long_data$ROI, ref="RTPJ_FuncMat")
summary(lmerTest::lmer(FuncMat_ROI ~ scale(GA_birth) + scale(T_age) + ROI + scale(MeanFD) + (1|Sub), data = FuncMat_long_data))
#summary(lmerTest::lmer(FuncMat_ROI ~ scale(GA_birth) + scale(T_age) + ROI + scale(num_sibs) + scale(MeanFD) + (1|Sub), data = FuncMat_long_data))
# IRC
#TEBC_IRC_Data <- read.csv("./EBC/Data/TEBC_other/TEBC_IRC_Data.csv")
#Abeletal_Data <- merge(Abeletal_Data, TEBC_IRC_Data, by = "Sub", all.x = T)
#write.csv(Abeletal_Data, file="./EBC/Data/Abeletal_Data.csv", row.names=FALSE)
#tmp <- Abeletal_Data %>% select(Sub, Preterm)
#TEBC_IRC_Data <- merge(TEBC_IRC_Data, tmp, by = "Sub", all.x =T)
fMRI_kids %>%
group_by(Preterm) %>%
summarize(
ToM_IRC_Mean = round(mean(ToM_IRC_AverageCorrelation, na.rm = TRUE), 2),
ToM_IRC_SD = round(sd(ToM_IRC_AverageCorrelation, na.rm = TRUE), 2),
ToM_IRC_SE = (ToM_IRC_SD/ sqrt(n())),
)
fMRI_kids %>%
group_by(Preterm) %>%
summarize(
Across_IRC_Mean = round(mean(Across_IRC_AverageCorrelation, na.rm = TRUE), 2),
Across_IRC_SD = round(sd(Across_IRC_AverageCorrelation, na.rm = TRUE), 2),
Across_IRC_SE = (Across_IRC_SD/ sqrt(n())),
)
split_IRC_Data <- split(fMRI_kids, fMRI_kids$Preterm)
t.test(split_IRC_Data$Yes$ToM_IRC_AverageCorrelation, split_IRC_Data$Yes$Across_IRC_AverageCorrelation, alternative = "greater", paired = T)
t.test(split_IRC_Data$No$ToM_IRC_AverageCorrelation, split_IRC_Data$No$Across_IRC_AverageCorrelation, alternative = "greater", paired = T)
summary(lm(ToM_IRC_AverageCorrelation ~ scale(GA_birth) + scale(T_age) + scale(MeanFD), data = Abeletal_Data))
summary(lm(Across_IRC_AverageCorrelation ~ scale(GA_birth) + scale(T_age) + scale(MeanFD), data = Abeletal_Data))
summary(lm(Pain_IRC_AverageCorrelation ~ scale(GA_birth) + scale(T_age) + scale(MeanFD), data = Abeletal_Data))
summary(lm(ToM_IRC_AverageCorrelation ~ scale(GA_birth) + scale(T_age) + scale(num_sibs) + scale(MeanFD), data = Abeletal_Data))
summary(lm(Across_IRC_AverageCorrelation ~ scale(GA_birth) + scale(T_age) + scale(num_sibs) + scale(MeanFD), data = Abeletal_Data))
summary(lm(Pain_IRC_AverageCorrelation ~ scale(GA_birth) + scale(T_age) + scale(num_sibs) + scale(MeanFD), data = Abeletal_Data))
Abeletal_Data$ToMIRC_acrossIRC <- (Abeletal_Data$ToM_IRC_AverageCorrelation - Abeletal_Data$Across_IRC_AverageCorrelation)
summary(lm(ToMIRC_acrossIRC ~ scale(GA_birth) + scale(T_age) + scale(MeanFD), data = Abeletal_Data))
#RM
#TEBC_RM_Data <- read.csv("./EBC/Data/TEBC_RM_Data.csv")
#Abeletal_Data <- merge(Abeletal_Data, TEBC_RM_Data, by = "Sub", all.x = T)
#write.csv(Abeletal_Data, file="./EBC/Data/Abeletal_Data.csv", row.names=FALSE)
#RTPJ
summary(lm(RTPJ_RMT01 ~ scale(GA_birth) + scale(T_age) + scale(MeanFD), data = Abeletal_Data))
summary(lm(RTPJ_RMT02 ~ scale(GA_birth) + scale(T_age) + scale(MeanFD), data = Abeletal_Data))
summary(lm(RTPJ_RMT04 ~ scale(GA_birth) + scale(T_age) + scale(MeanFD), data = Abeletal_Data))
summary(lm(RTPJ_RMT01 ~ scale(GA_birth) * scale(T_age) + scale(num_sibs) + scale(MeanFD), data = Abeletal_Data))
summary(lm(RTPJ_RMT02 ~ scale(GA_birth) + scale(T_age) + scale(num_sibs) + scale(MeanFD), data = Abeletal_Data))
summary(lm(RTPJ_RMT04 ~ scale(GA_birth) + scale(T_age) + scale(num_sibs) + scale(MeanFD), data = Abeletal_Data))
#Network-level analyses:
TEBC_RM_Data_long <- read.csv("./Data/Abeletal_PTB-ToM_RM_long.csv")
tmp <- Abeletal_Data %>% select(Sub, GA_birth, T_age, T_ToM_Score, MeanFD)
TEBC_RM_Data_long <- merge(TEBC_RM_Data_long, tmp, by = "Sub", all.x = T)
ToM <- c("DMPFC", "VMPFC", "PC", "MMPFC", "LTPJ", "RTPJ")
Pain <- c("LInsula", "RInsula", "AMCC", "RS2", "LS2", "RMFG", "LMFG")
TEBC_RM_Data_long <- TEBC_RM_Data_long %>%
mutate(Group = case_when(
ROI %in% ToM ~ "ToM",
ROI %in% Pain ~ "Pain",
TRUE ~ "Other" # Optional, for values not in A or B
))
class(TEBC_RM_Data_long$ROI)
TEBC_RM_Data_long$ROI <- as.factor(TEBC_RM_Data_long$ROI)
TEBC_RM_Data_long$ROI <- relevel(TEBC_RM_Data_long$ROI, ref="RTPJ")
split_TEBC_RM_Data_long <- split(TEBC_RM_Data_long, TEBC_RM_Data_long$Group)
#view(split_TEBC_RM_Data_long$ToM)
TEBC_RM_Data_long_ToM_RMT01 <- split_TEBC_RM_Data_long$ToM %>% filter(TimeGroup == "RMT01")
TEBC_RM_Data_long_ToM_RMT02 <- split_TEBC_RM_Data_long$ToM %>% filter(TimeGroup == "RMT02")
TEBC_RM_Data_long_ToM_RMT04 <- split_TEBC_RM_Data_long$ToM %>% filter(TimeGroup == "RMT04")
TEBC_RM_Data_long_Pain_RMT01 <- split_TEBC_RM_Data_long$Pain %>% filter(TimeGroup == "RMT01")
TEBC_RM_Data_long_Pain_RMT02 <- split_TEBC_RM_Data_long$Pain %>% filter(TimeGroup == "RMT02")
TEBC_RM_Data_long_Pain_RMT04 <- split_TEBC_RM_Data_long$Pain %>% filter(TimeGroup == "RMT04")
summary(lmerTest::lmer(Average_RM ~ scale(GA_birth) + scale(T_age) + ROI + scale(MeanFD) + (1|Sub), data = TEBC_RM_Data_long_ToM_RMT01))
summary(lmerTest::lmer(Average_RM ~ scale(GA_birth) + scale(T_age) + ROI + scale(GA_birth) * ROI + scale(MeanFD) + (1|Sub), data = TEBC_RM_Data_long_ToM_RMT02))
summary(lmerTest::lmer(Average_RM ~ scale(GA_birth) + scale(T_age) + ROI + scale(MeanFD) + (1|Sub), data = TEBC_RM_Data_long_ToM_RMT04))
summary(lmerTest::lmer(Average_RM ~ scale(GA_birth) + scale(T_age) + ROI + scale(GA_birth) * ROI + scale(MeanFD) + (1|Sub), data = TEBC_RM_Data_long_Pain_RMT01))
summary(lmerTest::lmer(Average_RM ~ scale(GA_birth) + scale(T_age) + ROI + scale(GA_birth) * ROI + scale(MeanFD) + (1|Sub), data = TEBC_RM_Data_long_Pain_RMT02))
summary(lmerTest::lmer(Average_RM ~ scale(GA_birth) + scale(T_age) + ROI + scale(MeanFD) + (1|Sub), data = TEBC_RM_Data_long_Pain_RMT04))
#additionl
summary(lm(RTPJ_RMT04 ~ scale(T_ToM_Score) + scale(GA_birth) + scale(T_age) + scale(MeanFD), data = Abeletal_Data))
summary(lm(RTPJ_RMT02 ~ scale(T_ToM_Score) + scale(GA_birth) + scale(T_age) + scale(MeanFD), data = Abeletal_Data))
summary(lm(RTPJ_RMT04 ~ scale(num_sibs) + scale(T_ToM_Score) + scale(MeanFD), data = Abeletal_Data))
summary(lm(RTPJ_RMT02 ~ scale(num_sibs) + scale(T_ToM_Score) + scale(MeanFD), data = Abeletal_Data))
summary(lmer(scale(Average_RM) ~ scale(T_ToM_Score) + scale(GA_birth) + scale(T_age) + ROI + scale(MeanFD) + (1|Sub),, data = TEBC_RM_Data_long_ToM_RMT04))
#Additional ISC's
#AverageCorrelations <- read.csv("./EBC/Data/TEBC_AverageCorrelations.csv")
#tmp <- AverageCorrelations %>% select(Sub:AverageCorrelation_averageToM_PTxMIT34)
#Abeletal_Data <- merge(Abeletal_Data, tmp, by = "Sub", all.x = T)
#Abeletal_Data <- Abeletal_Data %>% rename ("Preterm" = Preterm.x)
#write.csv(Abeletal_Data, file="./EBC/Data/Abeletal_Data.csv", row.names=FALSE)
Abeletal_Data %>%
group_by(Preterm) %>%
summarize(
Mean_RTPJ_withinPTorT = round(mean(AverageCorrelation_RTPJ_withinPTorT, na.rm = TRUE), 2),
Mean_averageToM_withinPTorT = round(mean(AverageCorrelation_averageToM_withinPTorT, na.rm = TRUE), 2),
Mean_RTPJ_PTxT = round(mean(AverageCorrelation_RTPJ_PTxT, na.rm = TRUE), 2),
Mean_averageToM_PTxT = round(mean(AverageCorrelation_averageToM_PTxT, na.rm = TRUE), 2))
Abeletal_Data %>%
group_by(Preterm) %>%
summarize(
Mean_RTPJ_TEBCxMIT5 = round(mean(AverageCorrelation_RTPJ_TEBCxMIT5, na.rm = TRUE), 2),
Mean_averageToM_TEBCxMIT5 = round(mean(AverageCorrelation_averageToM_TEBCxMIT5, na.rm = TRUE), 2),
Mean_RTPJ_PTxMIT34 = round(mean(AverageCorrelation_RTPJ_PTxMIT34, na.rm = TRUE), 2),
Mean_averageToM_PTxMIT34 = round(mean(AverageCorrelation_averageToM_PTxMIT34, na.rm = TRUE), 2))
Abeletal_Data %>%
group_by(Preterm) %>%
summarize(
SE_RTPJ_withinPTorT = ((sd(AverageCorrelation_RTPJ_withinPTorT, na.rm = TRUE))/ sqrt(n())),
SE_averageToM_withinPTorT = ((sd(AverageCorrelation_averageToM_withinPTorT, na.rm = TRUE))/ sqrt(n())),
SE_RTPJ_PTxT = ((sd(AverageCorrelation_RTPJ_PTxT, na.rm = TRUE))/ sqrt(n())),
SE_averageToM_PTxT = ((sd(AverageCorrelation_averageToM_PTxT, na.rm = TRUE))/ sqrt(n())))
Abeletal_Data %>%
group_by(Preterm) %>%
summarize(
SE_RTPJ_TEBCxMIT5 = ((sd(AverageCorrelation_RTPJ_TEBCxMIT5, na.rm = TRUE))/ sqrt(n())),
SE_averageToM_TEBCxMIT5 = ((sd(AverageCorrelation_averageToM_TEBCxMIT5, na.rm = TRUE))/ sqrt(n())),
SE_RTPJ_PTxMIT34 = ((sd(AverageCorrelation_RTPJ_PTxMIT34, na.rm = TRUE))/ sqrt(n())),
SE_averageToM_PTxMIT34 = ((sd(AverageCorrelation_averageToM_PTxMIT34, na.rm = TRUE))/ sqrt(n())),
)
split_AverageCorrelations <- split(fMRI_kids, fMRI_kids$Preterm)
#within PT , within T
t.test(split_AverageCorrelations$Yes$AverageCorrelation_RTPJ_withinPTorT, split_AverageCorrelations$No$AverageCorrelation_RTPJ_withinPTorT, alternative = "greater", paired = F)
t.test(split_AverageCorrelations$Yes$AverageCorrelation_averageToM_withinPTorT, split_AverageCorrelations$No$AverageCorrelation_averageToM_withinPTorT, alternative = "greater", paired = F)
#within T , within PT
t.test(split_AverageCorrelations$No$AverageCorrelation_RTPJ_withinPTorT, split_AverageCorrelations$Yes$AverageCorrelation_RTPJ_withinPTorT, alternative = "greater", paired = F)
t.test(split_AverageCorrelations$No$AverageCorrelation_averageToM_withinPTorT, split_AverageCorrelations$Yes$AverageCorrelation_averageToM_withinPTorT, alternative = "greater", paired = F)
#within-PT,across-PT-T
t.test(split_AverageCorrelations$Yes$AverageCorrelation_RTPJ_withinPTorT, split_AverageCorrelations$Yes$AverageCorrelation_RTPJ_PTxT, alternative = "greater", paired = T)
t.test(split_AverageCorrelations$Yes$AverageCorrelation_averageToM_withinPTorT, split_AverageCorrelations$Yes$AverageCorrelation_averageToM_PTxT, alternative = "greater", paired = T)
#within-PT,across-PT-T - post-hoc two tailed
t.test(split_AverageCorrelations$Yes$AverageCorrelation_RTPJ_withinPTorT, split_AverageCorrelations$Yes$AverageCorrelation_RTPJ_PTxT, alternative = "two.sided", paired = T)
t.test(split_AverageCorrelations$Yes$AverageCorrelation_averageToM_withinPTorT, split_AverageCorrelations$Yes$AverageCorrelation_averageToM_PTxT, alternative = "two.sided", paired = T)
#within-T,across-PT-T
t.test(split_AverageCorrelations$No$AverageCorrelation_RTPJ_withinPTorT, split_AverageCorrelations$No$AverageCorrelation_RTPJ_PTxT, alternative = "greater", paired = T)
t.test(split_AverageCorrelations$No$AverageCorrelation_averageToM_withinPTorT, split_AverageCorrelations$No$AverageCorrelation_averageToM_PTxT, alternative = "greater", paired = T)
#TEBC-PT – TEBC-T, TEBC-PT – MIT5-T
t.test(split_AverageCorrelations$Yes$AverageCorrelation_RTPJ_PTxT, split_AverageCorrelations$Yes$AverageCorrelation_RTPJ_TEBCxMIT5, alternative = "two.sided", paired = T)
t.test(split_AverageCorrelations$Yes$AverageCorrelation_averageToM_PTxT, split_AverageCorrelations$Yes$AverageCorrelation_averageToM_TEBCxMIT5, alternative = "two.sided", paired = T)
#TEBC-PT – MIT34-T , TEBC-PT – MIT5-T
t.test(split_AverageCorrelations$Yes$AverageCorrelation_RTPJ_PTxMIT34, split_AverageCorrelations$Yes$AverageCorrelation_RTPJ_TEBCxMIT5, alternative = "two.sided", paired = T)
t.test(split_AverageCorrelations$Yes$AverageCorrelation_averageToM_PTxMIT34, split_AverageCorrelations$Yes$AverageCorrelation_averageToM_TEBCxMIT5, alternative = "two.sided", paired = T)
sink()
#Timeshift analyses (not prereg)
# create txt with results
sink(paste0("./PTB_timeshift_IRC_results_", Sys.Date(), ".txt"))
# calculate means
fMRI_kids %>%
group_by(Preterm) %>%
summarise(mean_RTPJ_shift = mean(AverageCorrelation_RTPJ_PTxT_shift, na.rm = TRUE),
mean_averageToM_shift = mean(AverageCorrelation_averageToM_PTxT_shift, na.rm = TRUE),
mean_RTPJ_NOshift = mean(AverageCorrelation_RTPJ_PTxT_NOshift, na.rm = TRUE),
mean_averageToM_NOshift = mean(AverageCorrelation_averageToM_PTxT_NOshift, na.rm = TRUE),
SE_RTPJ_shift = ((sd(AverageCorrelation_RTPJ_PTxT_shift, na.rm = T))/ sqrt(n())),
SE_averageToM_shift = ((sd(AverageCorrelation_averageToM_PTxT_shift, na.rm = T))/ sqrt(n())),
SE_RTPJ_NOshift = ((sd(AverageCorrelation_RTPJ_PTxT_NOshift, na.rm = T))/ sqrt(n())),
SE_RTPJ_averageToM_NOshift = ((sd(AverageCorrelation_averageToM_PTxT_NOshift, na.rm = T))/ sqrt(n())),
)
# run stats
split_AverageCorrelations <- split(fMRI_kids, fMRI_kids$Preterm)
#across T_321, PT_2 vs across T_321, PT_321
t.test(split_AverageCorrelations$Yes$AverageCorrelation_RTPJ_PTxT_NOshift, split_AverageCorrelations$Yes$AverageCorrelation_RTPJ_PTxT_shift, alternative = "two.sided", paired = T)
t.test(split_AverageCorrelations$Yes$AverageCorrelation_averageToM_PTxT_NOshift, split_AverageCorrelations$Yes$AverageCorrelation_averageToM_PTxT_shift, alternative = "two.sided", paired = T)
sink()
#--------------------
##paper plots
library(patchwork)
desired_order_2 <- c("Yes", "No")
Plot_Abeletal_Data <- Abeletal_Data %>%
mutate(
Preterm = factor(Preterm, levels = desired_order_2))
# Figure 1 option 2 - JCPP
P1a <- ggplot(Plot_Abeletal_Data, aes(x=GA_birth, y=T_ToM_Score)) +
geom_point(size=4, alpha=0.7,aes(colour=Preterm)) +
scale_colour_manual(values = c("Yes"="deeppink3", "No"="goldenrod2"), labels = c("Term", "Preterm")) +
labs(x="Gestational Age", y="Proportion Correct", title= "a. ToM Booklet") +
ylim(0,1) +
guides(colour = guide_legend(override.aes = list(colour = "white")))+
scale_x_continuous(breaks = seq(24, 42, 3), minor_breaks=NULL) +
theme(legend.title = element_blank(),
plot.title = element_text(size=30,face="bold",hjust=.5),
panel.background = element_rect(fill="white"),
axis.line=element_line(color="black"),
axis.text=element_text(size=27),
axis.title=element_text(size=27,face="bold"),
legend.key=element_rect(fill="white"),
legend.text= element_blank(),
legend.position = "none") + #legend.text=element_text(size=20, lineheight=.8),legend.key.height=unit(2,"cm"))+
geom_smooth(method=lm, se=TRUE,colour="black")
P1d <- ggMarginal(P1a,type="violin", margins = c("y"), groupColour = TRUE, groupFill = TRUE)
print(P1d)
Item_type_long_data <- Plot_Abeletal_Data %>%
pivot_longer(
cols = AF_ToM_Score:T_ToM_Score, # Columns to pivot
names_to = "Item_type", # New column for the variable names
values_to = "Performance" # New column for the values
)
class(Item_type_long_data$Performance)
Item_type_long_data <- Item_type_long_data %>% filter(!is.na(FB_ToM_Score) & FB_ToM_Score != "")
Item_type_long_data <- Item_type_long_data %>%
mutate(Item_type = case_when(Item_type == "T_ToM_Score" ~ "All Items",
Item_type == "AF_ToM_Score" ~ "Forced choice",
Item_type == "E_ToM_Score" ~ "Free response"))
Item_type_long_data$Item_type <- factor(
Item_type_long_data$Item_type,
levels = c("All Items", "Forced choice", "Free response")
)
P1b <- ggplot(Item_type_long_data, aes(x = Item_type, y = Performance, fill = Preterm)) +
geom_violin(trim = FALSE, alpha = 0.6, aes(colour = Preterm)) +
scale_fill_manual(values = c("Yes" = "deeppink3", "No" = "goldenrod2"), labels = c("Preterm", "Term")) + #' Alpha makes the violin plots semi-transparent
geom_point(size=3, shape = 27, alpha=0.7,aes(colour = Preterm), position = position_jitterdodge(dodge.width = 0.85, jitter.width = 0.25)) +
scale_colour_manual(values = c("Yes" = "deeppink3", "No" = "goldenrod2"), labels = c("Preterm", "Term")) +
geom_boxplot(width = 0.2, position = position_dodge(width = 0.9), alpha = 0.7, color = "lightgrey", linewidth = 0.1) +
stat_summary(fun = mean, geom = "point", shape = 18, size = 4, alpha = 0.7,
position = position_dodge(width = 0.9)) +
labs(x = "Response Type", y = "Proportion Correct", title = "b. ToM Booklet by Response Type") +
ylim(0, 1) +
theme(legend.title = element_blank(),
plot.title = element_text(size=30,face="bold",hjust=.5),
axis.text.x = element_text(face = "bold", size = 23),
panel.background = element_rect(fill = "white"),
axis.line=element_line(color="black"),
axis.text=element_text(size=27),
axis.title=element_text(size=27,face="bold"),
legend.key = element_rect(fill = "white"),
legend.text = element_text(size = 23),
legend.key.height = unit(1.5, "cm"),
legend.position = "top"
)
print(P1b)
P1c <- ggplot(Plot_Abeletal_Data, aes(x=GA_birth, y=RL_PercentileRank)) +
geom_point(size=4, alpha=0.7,aes(color=Preterm)) +
scale_colour_manual(values = c("Yes"="deeppink3", "No"="goldenrod2")) +
guides(colour = guide_legend(override.aes = list(colour = "white")))+
labs(x="Gestational Age", y="Percentile Rank", title= "c. Receptive Language") + #ylim(100) +
scale_x_continuous(breaks = seq(24, 42, 3), minor_breaks=NULL) +
theme(legend.title = element_blank(),
plot.title = element_text(size=30,face="bold",hjust=.5),
panel.background = element_rect(fill="white"),
axis.line=element_line(color="black"),
axis.text=element_text(size=27),
axis.title=element_text(size=27,face="bold"),
legend.key=element_rect(fill="white"),
legend.text=element_blank(),
legend.position = "top") +
geom_smooth(method=lm, se=TRUE,colour="black")
P1f <- ggMarginal(P1c,type="violin", margins = c("y"), groupColour = TRUE, groupFill = TRUE)
print(P1f)
png("./JCPP_Figure1_141125.png", width = 2000, height = 732)
patchwork::wrap_elements(P1d) + patchwork::wrap_elements(P1b) + patchwork::wrap_elements(P1f) + plot_layout(guides = 'collect')
dev.off()
#supplement 1
S1a <- ggplot(Plot_Abeletal_Data, aes(x=GA_birth, y=Pix_ToM)) +
geom_point(size=4, alpha=0.7,aes(colour=Preterm)) +
scale_colour_manual(values = c("Yes"="deeppink3", "No"="goldenrod2"), labels = c("Preterm", "Term")) +
guides(colour = guide_legend(override.aes = list(colour = "white")))+
labs(x="Gestational Age", y="Proportion Correct", title= "Partly Cloudy ToM performance") +ylim(0,1) +
scale_x_continuous(breaks = seq(24, 42, 3), minor_breaks=NULL) +
theme(legend.title = element_blank(),
plot.title = element_text(size=20,face="bold",hjust=.5),
panel.background = element_rect(fill="white"),
axis.line=element_line(color="black"),
axis.text=element_text(size=16),
axis.title=element_text(size=16,face="bold"),
legend.key=element_rect(fill="white"),
legend.text= element_blank(),
legend.position = "left") + #legend.text=element_text(size=20, lineheight=.8),legend.key.height=unit(2,"cm"))+
geom_smooth(method=lm, se=TRUE,colour="black")
S1c <- ggMarginal(S1a,type="violin", margins = c("y"), groupColour = TRUE, groupFill = TRUE)
print(S1c)
S1d <- ggplot(Plot_Abeletal_Data, aes(x=T_ToM_Score, y=Pix_ToM)) +
geom_point(size=4, alpha=0.7,aes(colour=Preterm)) +
scale_colour_manual(values = c("Yes"="deeppink3", "No"="goldenrod2"), labels = c("Preterm", "Term")) +
labs(x="Booklet task Proportion Correct", y="Partly Cloudy task Proportion Correct", title= "ToM") +
ylim(0.2,1) +
xlim(0.2,1) +
#scale_x_continuous(breaks = seq(0.25, 0.50, 0.75), minor_breaks=NULL) +
theme(legend.title = element_blank(),
plot.title = element_text(size=20,face="bold",hjust=.5),
panel.background = element_rect(fill="white"),
axis.line=element_line(color="black"),
axis.text=element_text(size=16),
axis.title=element_text(size=16,face="bold"),
legend.key=element_rect(fill="white"),
legend.text= element_text(size=16, lineheight=.8),
legend.position = "right") + #legend.text=element_text(size=20, lineheight=.8),legend.key.height=unit(2,"cm"))+
geom_smooth(method=lm, se=TRUE,colour="black")
#S1d <- ggMarginal(S1b,type="violin", margins = c("y"), groupColour = TRUE, groupFill = TRUE)
print(S1d)
png("./SupplementalFigure1_290825.png", width = 1300, height = 500)
patchwork::wrap_elements(S1c) + patchwork::wrap_elements(S1d)
dev.off()
#Figure 2 whole brain
#Figure 3s TC plots - see TC.R
TEBC_TC_Data <- read.csv("./Data/Abeletal_PTB-ToM_timecourses_zscored.csv")
library(R.matlab)
Adult_TC_ToM_Data <- read.csv("./Data/Abeletal_PTB-ToM_adultTCs.csv") %>%
rename("group.RTPJ" = "averageAdultRTPJ", "group.LTPJ" = "averageAdultLTPJ", "group.DMPFC" = "averageAdultDMPFC", "group.MMPFC" = "averageAdultMMPFC", "group.VMPFC" = "averageAdultVMPFC", "group.PC" = "averageAdultPC", "group.avToM" = "averageAdultToM", "group.avPain" = "averageAdultaveragePain")
GA_group_data <- Abeletal_Data %>% select(Sub, Preterm, task, GA_birth, T_age, Sex)
GA_group_data <- GA_group_data %>% filter(!is.na(task))
GA_group_data$Sub <- as.character(GA_group_data$Sub)
#Create Participant lists
filtered_rows_PT <- GA_group_data %>%
filter(grepl("Yes", Preterm)) # Use grepl() to check for the string
print(filtered_rows_PT)
filtered_rows_T <- GA_group_data %>%
filter(grepl("No", Preterm)) # Use grepl() to check for the string
print(filtered_rows_T)
Preterm <- c("1010","1012","1016","1020","1026","1032","1034","1038","1039","1040",
"1042","1047","1048","1050","1052","1057","1058","1061","1075","1083",
"1085","1088","1090","1099","1103","1104","1109","1110","1111","1112")
Term <- c("1002","1006","1007","1008","1009","1011","1013","1014","1015","1018",
"1019","1021","1023","1024","1029","1031","1037","1043","1045","1051",
"1053","1054","1055","1063","1064","1066","1068","1069","1070","1072",
"1074","1077","1078","1079","1080","1084","1093","1095","1096","1097",
"1100","1101","1102","1106","1107","1107")
# Create network lists
ToM <- c("DMPFC", "VMPFC", "PC", "MMPFC", "LTPJ", "RTPJ")
Pain <- c("LInsula", "RInsula", "AMCC", "RS2", "LS2", "RMFG", "LMFG")
Adult.ToM <- c("group.RTPJ", "group.LTPJ", "group.PC", "group.DMPFC", "group.MMPFC", "group.VMPFC")
Adult_ToM_Data <- Adult_TC_ToM_Data %>% select (all_of(Adult.ToM))
#Remove all unused runs
TEBC_TC_Data <- TEBC_TC_Data %>%
group_by(Sub, run) %>%
filter(any(!is.na(RTPJ))) %>%
ungroup()
#average ToM and Pain Networks
TEBC_TC_Data <- TEBC_TC_Data %>%
mutate(averageToM = rowMeans(select(., all_of(ToM)))) %>% #ToM
mutate(averagePain = rowMeans(select(., all_of(Pain)))) #Pain
#look at avergae TC
library(reshape2)
AvToM_TC_Data <- TEBC_TC_Data %>% select(Sub, averageToM, time)
AvToM_TC_Data_plusAdults <- AvToM_TC_Data %>% pivot_wider(names_from = Sub, values_from = averageToM, names_prefix = "")
tmp <- Adult_TC_ToM_Data %>% select(group.avToM)
AvToM_TC_Data_plusAdults <- cbind(AvToM_TC_Data_plusAdults, tmp)
AvToM_TC_Data_plusAdults <- AvToM_TC_Data_plusAdults %>% rename(AvAdult = "group.avToM")
AvToM_TC_Data_plusAdults <- AvToM_TC_Data_plusAdults %>%
mutate(across(everything(), as.numeric))
warnings()
AvToM_TC_Group_Data <- AvToM_TC_Data_plusAdults %>%
mutate(
avgPreterm = rowMeans(across(all_of(Preterm)), na.rm = TRUE),
avgTerm = rowMeans(across(all_of(Term)), na.rm = TRUE)
)
Data_AvToM_TC_Group <- AvToM_TC_Group_Data %>% select(time, AvAdult, avgPreterm, avgTerm)
# Step 1: Melt the data into long format
TC_df_long <- melt(Data_AvToM_TC_Group, id.vars = "time", variable.name = "Subject", value.name = "Magnitude")
#view(TC_df_long)
# Step 2: Create the timecourse plot
P4a <- ggplot(TC_df_long, aes(x = time, y = Magnitude, color = Subject, group = Subject)) +
geom_line(linewidth = 2.5, alpha = 0.8) + # Add lines to connect the points
#geom_point(size = 1.5) + # Optional: Add points to show the actual values
labs(title = "a. ToM Network Timecourse", x = "Time (TR)", y = "Response Magnitude") +
theme_minimal() + # A clean theme for the plot
scale_color_manual(values = c("mediumorchid3", "deeppink3", "goldenrod1"), labels = c("Adult", "Preterm", "Term")) + # Custom colors for each subject (adjust as needed)
#geom_hline(yintercept = 0, linetype = "dashed", color = "darkgrey") + # Add horizontal line at y = 0
#geom_line(xintercept =192.5, color = "chartreuse", linewidth = 1) +
annotate("segment", y=-0.6, yend = 0.7, x= 192.5, xend = 192.5, color = "#ff00aa", linewidth = 2.5, alpha = 0.55) +
annotate("segment", y=-0.6, yend = 0.7, x= 262.5, xend = 262.5, color = "#ff00aa", linewidth = 2.5, alpha = 0.55) +
annotate("segment", y=-0.6, yend = 0.7, x= 300.5, xend = 300.5, color = "#ff00aa", linewidth = 2.5, alpha = 0.55) +
annotate("text", label="T02", x=192.5, y=-0.8, size=7) +
annotate("text", label="T01", x=262.5, y=-0.8, size=7) +
annotate("text", label="T04", x=300.5, y=-0.8, size=7) +
#geom_vline(xintercept =192.5, color = "#ff00aa", linewidth = 2, alpha = 0.7) + # linetype = "dashed",
#geom_vline(xintercept =262.5, color = "#ff00aa", linewidth = 2, alpha = 0.7) + #aaff00, linetype = "dashed",
#geom_vline(xintercept =300.5, color = "#ff00aa", linewidth = 2, alpha = 0.7) + # linetype = "dashed",
scale_x_continuous(breaks = seq(0, 323, by = 5), expand = c(0, 0)) + # Set x-axis breaks every 2 seconds
theme(legend.title = element_blank(),
plot.title = element_text(size=25,face="bold"),
axis.line = element_line(linewidth = 0.5, colour = "black"),
axis.title=element_text(size=23,face="bold"),
axis.text.x = element_text(size = 18, angle = -45),
axis.text.y = element_text(size = 18),
legend.text=element_text(size=22, lineheight=.8),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
legend.position = "top") # Make the axes lines more pronounced
print(P4a)
#Figure 3b
#ToM FuncMAt,
P5a. <- ggplot(Plot_Abeletal_Data, aes(x=GA_birth, y=ToM_FuncMat)) +
geom_smooth(method=lm, se=TRUE,colour="black") +
geom_point(size=3, alpha=0.7,aes(color=Preterm)) +
scale_colour_manual(values = c("Yes"="deeppink3", "No"="goldenrod2"), labels = c("Preterm", "Term")) +
labs(x="Gestational Age", y="Functional Maturity", title= "b. ToM Network FM") +
scale_y_continuous(breaks = seq(-0.75, 1.25, 0.25)) +
scale_x_continuous(breaks = seq(24, 42, 3), minor_breaks=NULL) +
theme(legend.title = element_blank(),
plot.title = element_text(size=25,face="bold",hjust=.5),
panel.background = element_rect(fill="white"),
axis.line=element_line(color="black"),
axis.text=element_text(size=18),
axis.title=element_text(size=23,face="bold"),
legend.key=element_rect(fill="white"),
legend.text=element_text(size = 21),
legend.position = "top")
P5a <- ggMarginal(P5a., type = "violin", margins = c("y"), groupColour = TRUE, groupFill = TRUE)
print(P5a)
#ToM T01
P5b. <- ggplot(Plot_Abeletal_Data, aes(x=GA_birth, y=averageToM_RMT01)) +
geom_smooth(method=lm, se=TRUE,colour="black") +
geom_point(size=3, alpha=0.7,aes(color=Preterm)) +
guides(colour = guide_legend(override.aes = list(colour = "white")))+
scale_colour_manual(values = c("Yes"="deeppink3", "No"="goldenrod2"), labels = c("Preterm", "Term")) +
labs(x="Gestational Age", y="Response Magnitude", title= "c. T01") +
scale_y_continuous(breaks = seq(-1, 1.25, 0.5)) +
scale_x_continuous(breaks = seq(24, 42, 3), minor_breaks=NULL) +
theme(legend.title = element_blank(),
plot.title = element_text(size=25,face="bold",hjust=.5),
panel.background = element_rect(fill="white"),
axis.line=element_line(color="black"),
axis.text=element_text(size=18),
axis.title=element_text(size=23,face="bold"),
legend.key=element_rect(fill="white"),
legend.text=element_blank(),
legend.position = "top")
P5b <- ggMarginal(P5b.,type="violin", margins = c("y"), groupColour = TRUE, groupFill = TRUE)
#ToM T02
P5c. <- ggplot(Plot_Abeletal_Data, aes(x=GA_birth, y=averageToM_RMT02)) +
geom_smooth(method=lm, se=TRUE,colour="black") +
geom_point(size=3, alpha=0.7,aes(color=Preterm)) +
guides(colour = guide_legend(override.aes = list(colour = "white")))+
scale_colour_manual(values = c("Yes"="deeppink3", "No"="goldenrod2"), labels = c("Preterm", "Term")) +
labs(x="Gestational Age", y="Response Magnitude", title= "d. T02") +
scale_y_continuous(breaks = seq(-1, 1.25, 0.5)) +
scale_x_continuous(breaks = seq(24, 42, 3), minor_breaks=NULL) +
theme(legend.title = element_blank(),
plot.title = element_text(size=25,face="bold",hjust=.5),
panel.background = element_rect(fill="white"),
axis.line=element_line(color="black"),
axis.text=element_text(size=18),
axis.title=element_text(size=23,face="bold"),
legend.key=element_rect(fill="white"),
legend.text=element_blank(),
legend.position = "top") #legend.text=element_text(size=20, lineheight=.8),legend.key.height=unit(2,"cm"))+
P5c <- ggMarginal(P5c.,type="violin", margins = c("y"), groupColour = TRUE, groupFill = TRUE)
#ToM T04
P5d. <- ggplot(Plot_Abeletal_Data, aes(x=GA_birth, y=averageToM_RMT04)) +
geom_smooth(method=lm, se=TRUE,colour="black") +
geom_point(size=3, alpha=0.7,aes(color=Preterm)) +
guides(colour = guide_legend(override.aes = list(colour = "white")))+
scale_colour_manual(values = c("Yes"="deeppink3", "No"="goldenrod2"), labels = c("Preterm", "Term")) +
labs(x="Gestational Age", y="Response Magnitude", title= "e. T04") +
scale_y_continuous(breaks = seq(-1, 1.25, 0.5)) +
scale_x_continuous(breaks = seq(24, 42, 3), minor_breaks=NULL) +
theme(legend.title = element_blank(),
plot.title = element_text(size=25,face="bold",hjust=.5),
panel.background = element_rect(fill="white"),
axis.line=element_line(color="black"),
axis.text=element_text(size=18),
axis.title=element_text(size=23,face="bold"),
legend.key=element_rect(fill="white"),
legend.text=element_blank(),
legend.position = "top") #legend.text=element_text(size=20, lineheight=.8),legend.key.height=unit(2,"cm"))+
P5d <- ggMarginal(P5d.,type="violin", margins = c("y"), groupColour = TRUE, groupFill = TRUE)
# JCPP Figure 3
png("./JCPP_Figure3_141125.png", width = 1500, height = 900)
P5i <- patchwork::wrap_elements(P5a) + patchwork::wrap_elements(P5b) +
patchwork::wrap_elements(P5c) + patchwork::wrap_elements(P5d) +
plot_layout(ncol = 4) + plot_layout(guides = 'collect')
JCPP3 <-
patchwork::wrap_elements(P4a) + patchwork::wrap_elements(P5i) +
plot_layout(ncol = 1)
print(JCPP3)
dev.off()
#Figure 4 - IRC
IRC_averageCorrelations <- read.csv("./Data/Abeletal_PTB-ToM_IRCaverageCorrelations.csv")
desired_order <- c("RTPJ", "LTPJ", "PC", "DMPFC", "MMPFC", "VMPFC", "RS2", "LS2", "RInsula", "LInsula", "RMFG", "LMFG", "AMCC")
IRC_averageCorrelations <- IRC_averageCorrelations %>%
mutate(
Var1 = factor(Var1, levels = desired_order),
Var2 = factor(Var2, levels = rev(desired_order)),
Preterm = factor(Preterm, levels = desired_order_2)
)
split_IRC_averageCorrelations <- split(IRC_averageCorrelations, IRC_averageCorrelations$Preterm)
P6a <- ggplot(split_IRC_averageCorrelations$No, aes(x = Var1, y = Var2, fill = AverageCorrelation)) +
geom_tile() +
scale_fill_gradient2(low = "purple", mid = "white", high = "orange",
limit = c(-0.4, 1.2),
name = "Correlation") +
theme_minimal() +
theme(axis.title = element_blank(),
axis.text.x = element_text(size = 14, angle = 45, hjust = 1, face = "bold"),
axis.text.y = element_text(size = 14, face = "bold"),
plot.title = element_text(size = 18, face = "bold", hjust=.5),
legend.title = element_text(size = 14)
) +
labs(title = "Term", x = "", y = "") +
annotate("segment", x=.5, xend=6.5, y=13.5, yend=13.5, linewidth = 2, color = "#ff00aa") +
annotate("segment", x=.5, xend=6.5, y=7.5, yend=7.5, linewidth = 2, color = "#ff00aa") +
annotate("segment", x=.5, xend= .5, y= 7.5, yend= 13.5, linewidth = 2, color = "#ff00aa") +
annotate("segment", x=6.5, xend=6.5, y=7.5, yend=13.5, linewidth = 2, color = "#ff00aa")
print(P6a)
P6b <- ggplot(split_IRC_averageCorrelations$Yes, aes(x = Var1, y = Var2, fill = AverageCorrelation)) +
geom_tile() +
scale_fill_gradient2(low = "purple", mid = "white", high = "orange",
limit = c(-0.4, 1.2),
name = "Correlation") +
theme_minimal() +
theme(axis.title = element_blank(),
axis.text.x = element_text(size = 14, angle = 45, hjust = 1, face = "bold"),
axis.text.y = element_text(size = 14, face = "bold"),
plot.title = element_text(size = 18, face = "bold", hjust=.5),
legend.title = element_text(size = 14)
) +
labs(title = "Preterm", x = "", y = "") +
annotate("segment", x=.5, xend=6.5, y=13.5, yend=13.5, linewidth = 2, color = "#ff00aa") +
annotate("segment", x=.5, xend=6.5, y=7.5, yend=7.5, linewidth = 2, color = "#ff00aa") +
annotate("segment", x=.5, xend= .5, y= 7.5, yend= 13.5, linewidth = 2, color = "#ff00aa") +
annotate("segment", x=6.5, xend=6.5, y=7.5, yend=13.5, linewidth = 2, color = "#ff00aa")
print(P6b)
P6c <- P6b + P6a +
plot_layout(axes = "collect") + plot_layout(guides = 'collect')
print(P6c) #1200 x 620
#IRC box plot
TEBC_IRC_Data_long <- Plot_Abeletal_Data %>%
pivot_longer(
cols = c(ToM_IRC_AverageCorrelation, Pain_IRC_AverageCorrelation, Across_IRC_AverageCorrelation),
names_to = "Variable",
values_to = "Value")
TEBC_IRC_Data_long <- TEBC_IRC_Data_long %>%
mutate(Variable = case_when(Variable == "ToM_IRC_AverageCorrelation" ~ "Within ToM",
Variable == "Pain_IRC_AverageCorrelation" ~ "Within Pain",
Variable == "Across_IRC_AverageCorrelation" ~ "Across ToM-Pain"))
TEBC_IRC_Data_long$Variable <- factor(
TEBC_IRC_Data_long$Variable,
levels = c("Within ToM", "Within Pain", "Across ToM-Pain")
)
P6d <- ggplot(TEBC_IRC_Data_long, aes(x = Variable, y = Value, fill = Preterm)) +
geom_point(size=3, shape = 21, alpha=0.7,aes(colour = Preterm), position = position_jitterdodge(dodge.width = 0.85, jitter.width = 0.25)) +
geom_violin(trim = FALSE, alpha = 0.6, aes(colour = Preterm)) + # Alpha makes the violin plots semi-transparent
geom_boxplot(width = 0.2, position = position_dodge(width = 0.9), alpha = 0.8, color = "lightgrey", linewidth = 0.1) +
stat_summary(fun = mean, geom = "point", shape = 18, size = 4, alpha = 0.7, position = position_dodge(width = 0.9)) +
scale_colour_manual(values = c("Yes" = "deeppink3", "No" = "goldenrod2"), labels = c("Preterm", "Term")) +
labs(title = " ", x = "Variable", y = "z-scored correlation") +
#scale_y_continuous(breaks = seq(-.25, 1, 0.25)) +
#geom_hline(yintercept = 0, linetype = "dashed", color = "darkgrey") + # Add horizontal line at y =
theme_minimal() +
scale_fill_manual(values = c("Yes" = "deeppink3", "No" = "goldenrod1"), labels = c("Preterm", "Term")) + # Customize colors
theme(plot.title = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
axis.line = element_blank(),
axis.text = element_text(size = 16, color = "black"),
axis.title.y = element_text(size = 16, face = "bold", line= 0),
axis.title.x = element_blank(),
legend.key = element_rect(fill = "white"),
legend.text = element_text(size = 16),
legend.title = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_line(linetype = "dashed", color = "darkgrey"),
legend.position = "right") # Tilt x-axis labels for better readability
print(P6d)
png("./Figure6b_310825.png", width = 850, height = 743)
P6 <- P6c / P6d
print(P6)
dev.off()
#Figure 5
ISC_long_data_RTPJ_a <- Plot_Abeletal_Data %>%
pivot_longer(
cols = c(AverageCorrelation_RTPJ_withinPTorT, AverageCorrelation_RTPJ_PTxT), # Columns to pivot
names_to = "Comparison", # New column for the variable names
values_to = "Correlation" # New column for the values
)
class(ISC_long_data_RTPJ_a$Correlation)
#Difficulty_long_data$Performance <- as.numeric(as.character(Difficulty_long_data$Performance))
#view(Difficulty_long_data)
ISC_long_data_RTPJ_a <- ISC_long_data_RTPJ_a %>% filter(!is.na(task))
ISC_long_data_RTPJ_a <- ISC_long_data_RTPJ_a %>%
mutate(Comparison = case_when(Comparison == "AverageCorrelation_RTPJ_withinPTorT" ~ "Within Group",
Comparison == "AverageCorrelation_RTPJ_PTxT" ~ "Preterm-Term",
))
ISC_long_data_RTPJ_a$Comparison <- factor(
ISC_long_data_RTPJ_a$Comparison,
levels = c("Within Group", "Preterm-Term", "TEBC-MIT3&4", "TEBC-MIT5")
)
split_ISC_long_data_RTPJ_a <- split(ISC_long_data_RTPJ_a, ISC_long_data_RTPJ_a$Preterm)
#ISC_long_data_RTPJ_a <- ISC_long_data_RTPJ_a %>%
# mutate(Group_Comparison = interaction(Preterm, Comparison, sep = "_"))
#ISC_long_data_RTPJ_a$Group_Comparison <- factor(
# ISC_long_data_RTPJ_a$Group_Comparison,
#levels = c("Yes_Within Group", "Yes_Across Preterm-Term", "No_Within Group", "No_Across Preterm-Term")
#)
P7a <- ggplot(split_ISC_long_data_RTPJ_a$Yes, aes(x = Comparison, y = Correlation, fill = Preterm)) +
geom_point(size=3, shape = 21, alpha=0.7,aes(colour = Preterm), position = position_jitter(0.1)) +
geom_line(aes(group = Sub, colour = "darkgrey"), linewidth = 0.7) +
geom_violin(trim = FALSE, alpha = 0.6, aes(colour = Preterm), scale = "count") + #' Alpha makes the violin plots semi-transparent
scale_colour_manual(values = c("Yes" = "deeppink3"), labels = c("Preterm")) +
#guides(colour = guide_legend(override.aes = list(colour = "white"))) +
geom_boxplot(width = 0.1, position = position_dodge(width = 0.9), alpha = 0.7, color = "lightgrey", linewidth = 0.1) +
stat_summary(fun = mean, geom = "point", shape = 18, size = 3, alpha = 0.7,
position = position_dodge(width = 0.9)) +
labs(x = " ", y = "z-scored correlation", title = "RTPJ") +
ylim(-0.5, 1) +
theme(
plot.title = element_text(size = 18, face = "bold"),
axis.text.x = element_text(face = "bold", size = 14),
panel.background = element_rect(fill = "white"),
axis.line = element_line(color = "black"),
axis.text = element_text(size = 14),
axis.title = element_text(size = 14, face = "bold"),
legend.title = element_blank(),
legend.key = element_rect(fill = "white"),
legend.text = element_text(size = 14),
#legend.key.height = unit(1.5, "cm"),
legend.position = "top"
) +
scale_fill_manual(values = c("Yes" = "deeppink3"), labels = c("Preterm")) #, guide = F
print(P7a)
P7aa <- ggplot(split_ISC_long_data_RTPJ_a$No, aes(x = Comparison, y = Correlation, fill = Preterm)) +
geom_point(size=3, shape = 21, alpha=0.7,aes(colour = Preterm), position = position_jitter(0.1)) +
geom_line(aes(group = Sub, colour = "darkgrey"), linewidth = 0.7) +
geom_violin(trim = FALSE, alpha = 0.6, aes(colour = Preterm), scale = "count") + #' Alpha makes the violin plots semi-transparent
#guides(colour = guide_legend(override.aes = list(colour = "white"))) +
scale_colour_manual(values = c("No" = "goldenrod2"), labels = c("Term")) +
geom_boxplot(width = 0.1, position = position_dodge(width = 0.9), alpha = 0.7, color = "lightgrey", linewidth = 0.1) +
stat_summary(fun = mean, geom = "point", shape = 18, size = 3, alpha = 0.7,
position = position_dodge(width = 0.9)) +
labs(x = " ", y = "z-scored correlation", title = "") +
ylim(-0.5, 1) +
theme(
plot.title = element_text(size = 18, face = "bold"),
axis.text.x = element_text(face = "bold", size = 14),
panel.background = element_rect(fill = "white"),
axis.line = element_line(color = "black"),
axis.text = element_text(size = 14),
axis.title = element_text(size = 14, face = "bold"),
legend.title = element_blank(),
legend.key = element_rect(fill = "white"),
legend.text = element_text(size = 14),
#legend.key.height = unit(1.5, "cm"),
legend.position = "top"
) +
scale_fill_manual(values = c("No" = "goldenrod2"), labels = c("Term")) #,guide = F
print(P7aa)
split_ISC_long_data_RTPJ_aaa <- split(ISC_long_data_RTPJ_a, ISC_long_data_RTPJ_a$Comparison)
P7aaa <- ggplot(split_ISC_long_data_RTPJ_aaa$"Within Group", aes(x = Comparison, y = Correlation, fill = Preterm)) +
geom_point(size=3, shape = 21, alpha=0.7,aes(colour = Preterm), position = position_jitterdodge(dodge.width = 0.85, jitter.width = 0.15)) +
geom_violin(trim = FALSE, alpha = 0.6, aes(colour = Preterm), scale = "count") + #' Alpha makes the violin plots semi-transparent
scale_colour_manual(values = c("Yes" = "deeppink3", "No" = "goldenrod2"), labels = c("Preterm", "Term")) +
#guides(colour = guide_legend(override.aes = list(colour = "white"))) +
geom_boxplot(width = 0.1, position = position_dodge(width = 0.9), alpha = 0.7, color = "lightgrey", linewidth = 0.1) +
stat_summary(fun = mean, geom = "point", shape = 18, size = 3, alpha = 0.7,
position = position_dodge(width = 0.9)) +
labs(x = " ", y = "z-scored correlation", title = "") +
ylim(-0.5, 1) +
theme(
plot.title = element_text(size = 18, face = "bold"),
axis.text.x = element_text(face = "bold", size = 14),
panel.background = element_rect(fill = "white"),
axis.line = element_line(color = "black"),
axis.text = element_text(size = 14),
axis.title = element_text(size = 14, face = "bold"),
legend.title = element_blank(),
legend.key = element_rect(fill = "white"),
legend.text = element_text(size = 14),
#legend.key.height = unit(1.5, "cm"),
legend.position = "top"
) +
scale_fill_manual(values = c("Yes" = "deeppink3", "No" = "goldenrod2"), labels = c("Preterm", "Term")) #, guide = F
print(P7aaa)
ISC_long_data_RTPJ_b <- Abeletal_Data %>%
pivot_longer(
cols = c(AverageCorrelation_RTPJ_TEBCxMIT5, AverageCorrelation_RTPJ_PTxMIT34), # Columns to pivot
names_to = "Comparison", # New column for the variable names
values_to = "Correlation" # New column for the values
)
class(ISC_long_data_RTPJ_b$Correlation)
#Difficulty_long_data$Performance <- as.numeric(as.character(Difficulty_long_data$Performance))
#view(Difficulty_long_data)
ISC_long_data_RTPJ_b <- ISC_long_data_RTPJ_b %>% filter(!is.na(task))
ISC_long_data_RTPJ_b <- ISC_long_data_RTPJ_b %>%
mutate(Comparison = case_when(Comparison == "AverageCorrelation_RTPJ_TEBCxMIT5" ~ "TEBC-MIT5",
Comparison == "AverageCorrelation_RTPJ_PTxMIT34" ~ "TEBC-MIT3&4"))
ISC_long_data_RTPJ_b$Comparison <- factor(
ISC_long_data_RTPJ_b$Comparison,
levels = c("Within Group", "Preterm-Term", "TEBC-MIT3&4", "TEBC-MIT5")
)
split_ISC_long_data_RTPJ_b <- split(ISC_long_data_RTPJ_b, ISC_long_data_RTPJ_b$Preterm)
P7b <- ggplot(split_ISC_long_data_RTPJ_b$Yes, aes(x = Comparison, y = Correlation, fill = Preterm)) +
geom_point(size=3, shape = 21, alpha=0.7,aes(colour = Preterm), position = position_jitter(0.1)) +
geom_line(aes(group = Sub, colour = "darkgrey"), linewidth = 0.7) +
geom_violin(trim = FALSE, alpha = 0.6, aes(colour = Preterm), scale = "count") + #' Alpha makes the violin plots semi-transparent
scale_colour_manual(values = c("Yes" = "deeppink3"), labels = c("Preterm")) +
geom_boxplot(width = 0.1, position = position_dodge(width = 0.9), alpha = 0.7, color = "lightgrey", linewidth = 0.1) +
stat_summary(fun = mean, geom = "point", shape = 18, size = 3, alpha = 0.7,
position = position_dodge(width = 0.9)) +
labs(x = " ", y = "z-scored correlation", title = "") +
ylim(-0.5, 1) +
theme(
plot.title = element_text(size = 18, face = "bold"),
axis.text.x = element_text(face = "bold", size = 14),
panel.background = element_rect(fill = "white"),
axis.line = element_line(color = "black"),
axis.text = element_text(size = 14),
axis.title = element_text(size = 14, face = "bold"),
legend.title = element_blank(),
legend.key = element_rect(fill = "white"),
legend.text = element_text(size = 14),
#legend.key.height = unit(1.5, "cm"),,
legend.position = "top"
) +
scale_fill_manual(values = c("Yes" = "deeppink3"), labels = c("Preterm"))
print(P7b)
P7 <- (patchwork::wrap_elements(P7aaa) + patchwork::wrap_elements(P7a) + patchwork::wrap_elements(P7aa) + patchwork::wrap_elements(P7b)) + plot_layout(ncol = 4) + plot_layout(guides = "collect") + plot_layout(axis_titles = "collect") + plot_layout(axes = "collect")
print(P7)
#Network
ISC_long_data_averageToM_a <- Plot_Abeletal_Data %>%
pivot_longer(
cols = c(AverageCorrelation_averageToM_withinPTorT, AverageCorrelation_averageToM_PTxT), # Columns to pivot
names_to = "Comparison", # New column for the variable names
values_to = "Correlation" # New column for the values
)
class(ISC_long_data_averageToM_a$Correlation)
#Difficulty_long_data$Performance <- as.numeric(as.character(Difficulty_long_data$Performance))
#view(Difficulty_long_data)
ISC_long_data_averageToM_a <- ISC_long_data_averageToM_a %>% filter(!is.na(task))
ISC_long_data_averageToM_a <- ISC_long_data_averageToM_a %>%
mutate(Comparison = case_when(Comparison == "AverageCorrelation_averageToM_withinPTorT" ~ "Within Group",
Comparison == "AverageCorrelation_averageToM_PTxT" ~ "Preterm-Term",
))
ISC_long_data_averageToM_a$Comparison <- factor(
ISC_long_data_averageToM_a$Comparison,
levels = c("Within Group", "Preterm-Term", "TEBC-MIT3&4", "TEBC-MIT5")
)
split_ISC_long_data_averageToM_a <- split(ISC_long_data_averageToM_a, ISC_long_data_averageToM_a$Preterm)
#ISC_long_data_averageToM_a <- ISC_long_data_averageToM_a %>%
# mutate(Group_Comparison = interaction(Preterm, Comparison, sep = "_"))
#ISC_long_data_averageToM_a$Group_Comparison <- factor(
# ISC_long_data_averageToM_a$Group_Comparison,
#levels = c("Yes_Within Group", "Yes_Across Preterm-Term", "No_Within Group", "No_Across Preterm-Term")
#)
P7Na <- ggplot(split_ISC_long_data_averageToM_a$Yes, aes(x = Comparison, y = Correlation, fill = Preterm)) +
geom_point(size=3, shape = 21, alpha=0.7,aes(colour = Preterm), position = position_jitter(0.1)) +
geom_line(aes(group = Sub, colour = "darkgrey"), linewidth = 0.7) +
geom_violin(trim = FALSE, alpha = 0.6, aes(colour = Preterm), scale = "count") + #' Alpha makes the violin plots semi-transparent
scale_colour_manual(values = c("Yes" = "deeppink3"), labels = c("Preterm")) +
#guides(colour = guide_legend(override.aes = list(colour = "white"))) +
geom_boxplot(width = 0.1, position = position_dodge(width = 0.9), alpha = 0.7, color = "lightgrey", linewidth = 0.1) +
stat_summary(fun = mean, geom = "point", shape = 18, size = 3, alpha = 0.7,
position = position_dodge(width = 0.9)) +
labs(x = " ", y = "z-scored correlation", title = "ToM Network") +
scale_y_continuous(limits = c(-0.5, 1)) +
theme(
plot.title = element_text(size = 18, face = "bold"),
axis.text.x = element_text(face = "bold", size = 14),
panel.background = element_rect(fill = "white"),
axis.line = element_line(color = "black"),
axis.text = element_text(size = 14),
axis.title.y = element_text(size = 14, face = "bold"),
axis.title.x = element_blank(),
legend.title = element_blank(),
legend.key = element_rect(fill = "white"),
legend.text = element_text(size = 14),
#legend.key.height = unit(1.5, "cm"),
legend.position = "top"
) +
scale_fill_manual(values = c("Yes" = "deeppink3"), labels = c("Preterm")) #, guide = F
print(P7Na)
P7Naa <- ggplot(split_ISC_long_data_averageToM_a$No, aes(x = Comparison, y = Correlation, fill = Preterm)) +
geom_point(size=3, shape = 21, alpha=0.7,aes(colour = Preterm), position = position_jitter(0.1)) +
geom_line(aes(group = Sub, colour = "darkgrey"), linewidth = 0.7) +
geom_violin(trim = FALSE, alpha = 0.6, aes(colour = Preterm), scale = "count") + #' Alpha makes the violin plots semi-transparent
#guides(colour = guide_legend(override.aes = list(colour = "white"))) +
scale_colour_manual(values = c("No" = "goldenrod2"), labels = c("Term")) +
geom_boxplot(width = 0.1, position = position_dodge(width = 0.9), alpha = 0.7, color = "lightgrey", linewidth = 0.1) +
stat_summary(fun = mean, geom = "point", shape = 18, size = 3, alpha = 0.7,
position = position_dodge(width = 0.9)) +
labs(x = " ", y = "z-scored correlation", title = "") +
scale_y_continuous(limits = c(-0.5, 1)) +
theme(
plot.title = element_text(size = 18, face = "bold"),
axis.text.x = element_text(face = "bold", size = 14),
panel.background = element_rect(fill = "white"),
axis.line = element_line(color = "black"),
axis.text = element_text(size = 14),
axis.title.y = element_text(size = 14, face = "bold"),
axis.title.x = element_blank(),
legend.title = element_blank(),
legend.key = element_rect(fill = "white"),
legend.text = element_text(size = 14),
#legend.key.height = unit(1.5, "cm"),
legend.position = "top"
) +
scale_fill_manual(values = c("No" = "goldenrod2"), labels = c("Term")) #,guide = F
print(P7Naa)
split_ISC_long_data_averageToM_aaa <- split(ISC_long_data_averageToM_a, ISC_long_data_averageToM_a$Comparison)
P7Naaa <- ggplot(split_ISC_long_data_averageToM_aaa$"Within Group", aes(x = Comparison, y = Correlation, fill = Preterm)) +
geom_point(size=3, shape = 21, alpha=0.7,aes(colour = Preterm), position = position_jitterdodge(dodge.width = 0.85, jitter.width = 0.15)) +
geom_violin(trim = FALSE, alpha = 0.6, aes(colour = Preterm), scale = "count") + #' Alpha makes the violin plots semi-transparent
scale_colour_manual(values = c("Yes" = "deeppink3", "No" = "goldenrod2"), labels = c("Preterm", "Term")) +
#guides(colour = guide_legend(override.aes = list(colour = "white"))) +
geom_boxplot(width = 0.1, position = position_dodge(width = 0.9), alpha = 0.7, color = "lightgrey", linewidth = 0.1) +
stat_summary(fun = mean, geom = "point", shape = 18, size = 3, alpha = 0.7,
position = position_dodge(width = 0.9)) +
labs(x = " ", y = "z-scored correlation", title = "") +
scale_y_continuous(limits = c(-0.5, 1)) +
theme(
plot.title = element_text(size = 18, face = "bold"),
axis.text.x = element_text(face = "bold", size = 14),
panel.background = element_rect(fill = "white"),
axis.line = element_line(color = "black"),
axis.text = element_text(size = 14),
axis.title.y = element_text(size = 14, face = "bold"),
axis.title.x = element_blank(),
legend.title = element_blank(),
legend.key = element_rect(fill = "white"),
legend.text = element_text(size = 14),
#legend.key.height = unit(1.5, "cm"),
legend.position = "top"
) +
scale_fill_manual(values = c("Yes" = "deeppink3", "No" = "goldenrod2"), labels = c("Preterm", "Term")) #, guide = F
print(P7Naaa)
ISC_long_data_averageToM_b <- Abeletal_Data %>%
pivot_longer(
cols = c(AverageCorrelation_averageToM_TEBCxMIT5, AverageCorrelation_averageToM_PTxMIT34), # Columns to pivot
names_to = "Comparison", # New column for the variable names
values_to = "Correlation" # New column for the values
)
class(ISC_long_data_averageToM_b$Correlation)
#Difficulty_long_data$Performance <- as.numeric(as.character(Difficulty_long_data$Performance))
#view(Difficulty_long_data)
ISC_long_data_averageToM_b <- ISC_long_data_averageToM_b %>% filter(!is.na(task))
ISC_long_data_averageToM_b <- ISC_long_data_averageToM_b %>%
mutate(Comparison = case_when(Comparison == "AverageCorrelation_averageToM_TEBCxMIT5" ~ "TEBC-MIT5",
Comparison == "AverageCorrelation_averageToM_PTxMIT34" ~ "TEBC-MIT3&4"))
ISC_long_data_averageToM_b$Comparison <- factor(
ISC_long_data_averageToM_b$Comparison,
levels = c("Within Group", "Preterm-Term", "TEBC-MIT3&4", "TEBC-MIT5")
)
split_ISC_long_data_averageToM_b <- split(ISC_long_data_averageToM_b, ISC_long_data_averageToM_b$Preterm)
P7Nb <- ggplot(split_ISC_long_data_averageToM_b$Yes, aes(x = Comparison, y = Correlation, fill = Preterm)) +
geom_point(size=3, shape = 21, alpha=0.7,aes(colour = Preterm), position = position_jitter(0.1)) +
geom_line(aes(group = Sub, colour = "darkgrey"), linewidth = 0.7) +
geom_violin(trim = FALSE, alpha = 0.6, aes(colour = Preterm), scale = "count") + #' Alpha makes the violin plots semi-transparent
scale_colour_manual(values = c("Yes" = "deeppink3"), labels = c("Preterm")) +
geom_boxplot(width = 0.1, position = position_dodge(width = 0.9), alpha = 0.7, color = "lightgrey", linewidth = 0.1) +
stat_summary(fun = mean, geom = "point", shape = 18, size = 3, alpha = 0.7,
position = position_dodge(width = 0.9)) +
labs(x = " ", y = "z-scored correlation", title = "") +
scale_y_continuous(limits = c(-0.5, 1)) +
theme(
plot.title = element_text(size = 18, face = "bold"),
axis.text.x = element_text(face = "bold", size = 14),
panel.background = element_rect(fill = "white"),
axis.line = element_line(color = "black"),
axis.text = element_text(size = 14),
axis.title.y = element_text(size = 14, face = "bold"),
axis.title.x = element_blank(),
legend.title = element_blank(),
legend.key = element_rect(fill = "white"),
legend.text = element_text(size = 14),
#legend.key.height = unit(1.5, "cm"),,
legend.position = "top"
) +
scale_fill_manual(values = c("Yes" = "deeppink3"), labels = c("Preterm"))
print(P7Nb)
P71 <- (patchwork::wrap_elements(P7aaa) + patchwork::wrap_elements(P7a) + patchwork::wrap_elements(P7aa) + patchwork::wrap_elements(P7b)) + theme(axis.title.x = element_blank()) + plot_layout(ncol = 4) + plot_layout(guides = "collect") + plot_layout(axis_titles = "collect") + plot_layout(axes = "collect_y")
print(P71)
P72 <- (patchwork::wrap_elements(P7Naaa) + patchwork::wrap_elements(P7Na) + patchwork::wrap_elements(P7Naa) + patchwork::wrap_elements(P7Nb)) + plot_layout(ncol = 4) + plot_layout(guides = "collect") + plot_layout(axis_titles = "collect") + plot_layout(axes = "collect")
print(P72)
P7 <- (P72 / P71) + plot_layout(guides = "collect") + plot_layout(axis_titles = "collect") + plot_layout(axes = "collect")
png("./Figure7_290725.png", width = 1500, height = 743)
print(P7)
dev.off()
#P7c <- P7a + P7b + plot_layout(axes = "collect") + plot_layout(guides = "collect") + plot_layout(widths = c(2, 1))
#P7f <- P7d + P7e + plot_layout(axes = "collect") + plot_layout(guides = "collect") + plot_layout(widths = c(2, 1))
#P7 <- P7c / P7f #+ plot_layout(axes = "collect") + plot_layout(guides = "collect") + plot_layout(widths = c(2.5, 1))
# S3 motion plots
S3a. <- ggplot(Plot_Abeletal_Data, aes(x=GA_birth, y=MeanFD)) +
geom_point(size=4, alpha=0.7,aes(colour=Preterm)) +
scale_colour_manual(values = c("Yes"="deeppink3", "No"="goldenrod2"), labels = c("Preterm", "Term")) +
labs(x="Gestational Age", y="Mean FD", title= "Full sample") +
scale_x_continuous(breaks = seq(24, 42, 3), minor_breaks=NULL) +
ylim(0,1.2) +
theme(legend.title = element_blank(),
plot.title = element_text(size=20),
panel.background = element_rect(fill="white"),
axis.line=element_line(color="black"),
axis.text=element_text(size=18),
axis.title=element_text(size=18,face="bold"),
legend.key=element_rect(fill="white"),
legend.text= element_text(size=18),
legend.position = "none") + #legend.text=element_text(size=20, lineheight=.8),legend.key.height=unit(2,"cm"))+
geom_smooth(method=lm, se=TRUE,colour="black")
S3a<- ggMarginal(S3a.,type="violin", margins = c("y"), groupColour = TRUE, groupFill = TRUE)
print(S3a)
S3b. <- ggplot(Plot_Abeletal_Data, aes(x=GA_birth, y=X.Artifacts_ART)) +
geom_point(size=4, alpha=0.7,aes(colour=Preterm)) +
scale_colour_manual(values = c("Yes"="deeppink3", "No"="goldenrod2"), labels = c("Preterm", "Term")) +
labs(x="Gestational Age", y="Artifact Timepoints", title= "") +
scale_x_continuous(breaks = seq(24, 42, 3), minor_breaks=NULL) +
ylim(0,100) +
theme(legend.title = element_blank(),
plot.title = element_text(size=20),
panel.background = element_rect(fill="white"),
axis.line=element_line(color="black"),
axis.text=element_text(size=18),
axis.title=element_text(size=18,face="bold"),
legend.key=element_rect(fill="white"),
legend.text= element_text(size=18),
legend.position = "left") + #legend.text=element_text(size=20, lineheight=.8),legend.key.height=unit(2,"cm"))+
geom_smooth(method=lm, se=TRUE,colour="black")
S3b <- ggMarginal(S3b.,type="violin", margins = c("y"), groupColour = TRUE, groupFill = TRUE)
print(S3b)
S3.1 <- patchwork::wrap_elements(S3a) + patchwork::wrap_elements(S3b) + plot_layout(guides = "collect") +
plot_layout(widths = c(1, 1.3))
png("./Supplementals_Figure3.1_290725.png", width = 1200, height = 450)
print(S3.1)
dev.off()
#S3 motion in matched groups- see "TEBC_SubGroup_analyses.R"
S3 <- S3.1 / S3.2 + plot_layout(guides = "collect")
png("./Supplementals_Figure3_290725.png", width = 1200, height = 900)
print(S3)
dev.off()
#S2 site effects
ISC_long_data_RTPJ_d <- Plot_Abeletal_Data %>%
pivot_longer(
cols = c(AverageCorrelation_RTPJ_PTxT, AverageCorrelation_RTPJ_TEBCxMIT5), # Columns to pivot
names_to = "Comparison", # New column for the variable names
values_to = "Correlation" # New column for the values
)
class(ISC_long_data_RTPJ_d$Correlation)
#Difficulty_long_data$Performance <- as.numeric(as.character(Difficulty_long_data$Performance))
#view(Difficulty_long_data)
ISC_long_data_RTPJ_d <- ISC_long_data_RTPJ_d %>% filter(!is.na(task))
ISC_long_data_RTPJ_d <- ISC_long_data_RTPJ_d %>%
mutate(Comparison = case_when(Comparison == "AverageCorrelation_RTPJ_PTxT" ~ "PT TEBC - T TEBC",
Comparison == "AverageCorrelation_RTPJ_TEBCxMIT5" ~ "PT TEBC - T MIT5"))
ISC_long_data_RTPJ_d$Comparison <- factor(
ISC_long_data_RTPJ_d$Comparison,
levels = c("PT TEBC - T TEBC", "PT TEBC - T MIT5")
)
split_ISC_long_data_RTPJ_d <- split(ISC_long_data_RTPJ_d, ISC_long_data_RTPJ_d$Preterm)
S2a <- ggplot(split_ISC_long_data_RTPJ_d$Yes, aes(x = Comparison, y = Correlation, fill = Preterm)) +
geom_point(size=3, shape = 21, alpha=0.7,aes(colour = Preterm), position = position_jitter(0.1)) +
geom_line(aes(group = Sub, colour = "darkgrey"), linewidth = 0.7) +
geom_violin(trim = FALSE, alpha = 0.6, aes(colour = Preterm), scale = "count") + #' Alpha makes the violin plots semi-transparent
scale_colour_manual(values = c("Yes" = "deeppink3"), labels = c("Preterm")) +
geom_boxplot(width = 0.1, position = position_dodge(width = 0.9), alpha = 0.7, color = "lightgrey", linewidth = 0.1) +
stat_summary(fun = mean, geom = "point", shape = 18, size = 3, alpha = 0.7,
position = position_dodge(width = 0.9)) +
labs(x = " ", y = "z-scored correlation", title = "RTPJ") +
ylim(-0.5, 1) +
theme(
plot.title = element_text(size = 22, face = "bold"),
axis.text.x = element_text(face = "bold", size = 18),
panel.background = element_rect(fill = "white"),
axis.line = element_line(color = "black"),
axis.text = element_text(size = 18),
axis.title.y = element_text(size = 20, face = "bold"),
axis.title.x = element_blank(),
legend.title = element_blank(),
legend.key = element_rect(fill = "white"),
legend.text = element_text(size = 18),
#legend.key.height = unit(1.5, "cm"),,
legend.position = "top"
) +
scale_fill_manual(values = c("Yes" = "deeppink3"), labels = c("Preterm"))
print(S2a)
#Figure S3
# Pivot from wide to long format
Difficulty_long_data <- Plot_Abeletal_Data %>%
pivot_longer(
cols = Easy_ToM_Score:Hard_ToM_Score, # Columns to pivot
names_to = "Difficulty", # New column for the variable names
values_to = "Performance" # New column for the values
)
class(Difficulty_long_data$Performance)
#Difficulty_long_data$Performance <- as.numeric(as.character(Difficulty_long_data$Performance))
#view(Difficulty_long_data)
Difficulty_long_data <- Difficulty_long_data %>% filter(!is.na(T_ToM_Score) & T_ToM_Score != "")
TEBC_ToM_Difficulty <- lmerTest::lmer(Performance ~ scale(GA_birth) + Difficulty + scale(T_age) + scale(RL_PercentileRank) + (1 | Sub), data = Difficulty_long_data) #+ scale(num_sibs)
summary(TEBC_ToM_Difficulty)
Difficulty_long_data <- Difficulty_long_data %>%
mutate(Difficulty = case_when(Difficulty == "Easy_ToM_Score" ~ "Easy",
Difficulty == "FB_ToM_Score" ~ "FB",
Difficulty == "Hard_ToM_Score" ~ "Hard"))
Difficulty_long_data$Difficulty <- factor(
Difficulty_long_data$Difficulty,
levels = c("Easy", "FB", "Hard")
)
png("./FigureS3_260825.png", width = 800, height = 500)
PS3 <- ggplot(Difficulty_long_data, aes(x = Difficulty, y = Performance, fill = Preterm)) +
geom_violin(trim = FALSE, alpha = 0.6, aes(colour = Preterm)) +
scale_fill_manual(values = c("Yes" = "deeppink3", "No" = "goldenrod2"), labels = c("Preterm", "Term")) + #' Alpha makes the violin plots semi-transparent
geom_point(size=3, shape = 21, alpha=0.7,aes(colour = Preterm), position = position_jitterdodge(dodge.width = 0.85, jitter.width = 0.25)) +
scale_colour_manual(values = c("Yes" = "deeppink3", "No" = "goldenrod2"), labels = c("Preterm", "Term")) +
geom_boxplot(width = 0.2, position = position_dodge(width = 0.9), alpha = 0.7, color = "lightgrey", linewidth = 0.1) +
stat_summary(fun = mean, geom = "point", shape = 18, size = 4, alpha = 0.7,
position = position_dodge(width = 0.9)) +
labs(x = "Difficulty", y = "Proportion Correct", title = "ToM booklet by Item Difficulty") +
ylim(0, 1) +
theme(
legend.title = element_blank(),
plot.title = element_text(size=20,face="bold",hjust=.5),
axis.text.x = element_text(face = "bold", size = 16),
panel.background = element_rect(fill = "white"),
axis.line = element_line(color = "black"),
axis.text = element_text(size = 16),
axis.title = element_text(size = 16, face = "bold"),
legend.key = element_rect(fill = "white"),
legend.text = element_text(size = 16),
legend.key.height = unit(1.5, "cm"),
#legend.position = "top"
)
print(PS3)
dev.off()

Abeletal_PTB-ToM_mainAnalyses.R, no license · at the source

Overview

Authors: Selina Abel^1,2, Melissa Thye^1,3, Katie Mckinnon¹, Rebekah Smikle¹, Jean Skelton³, Lorena Jiménez-Sánchez³, Ray Amir¹, Gayle Barclay⁴, Charlotte Jardine⁴, Donna Mcintyre⁴, Iona Hamilton⁴, Yu Wei Chua⁵, Aditi Hosangadi⁶, Alan Quigley⁷, G David Batty⁸, Michael J Thrippleton^2,4, Heather C Whalley², James P Boardman^1,2, Hilary Richardson³

ORCID iDs: Selina Abel, Melissa Thye, Katie Mckinnon, Rebekah Smikle, Jean Skelton, Lorena Jiménez-Sánchez, Yu Wei Chua, James P Boardman, Hilary Richardson

Institutions: MRC Centre for Reproductive Health (United Kingdom); University of Edinburgh (United Kingdom); Edinburgh Royal Infirmary (United Kingdom); University of Liverpool (United Kingdom); University of Wisconsin–Madison (United States); University College London (United Kingdom)

Journal: Imaging neuroscience (Cambridge, Mass.), volume 4, article IMAG.a.1347

Dates: received 3 February 2026; accepted 26 July 2026; published online 26 August 2026

Type: Research article · Language: English

License: CC BY

Identifiers: DOI 10.1162/imag.a.1347 · PMID 42662222 · PMCID PMC13519987 · OpenAlex W7201880297

Open access: diamond, a free copy (OpenAlex)

Status: code verified

Categories: fMRI (modality), human (organism), other condition (population)

Methods: Connectivity, Statistics, Preprocessing, fMRI & imaging

Keywords: theory of mind, functional MRI (fMRI), social cognition, cognitive development, preterm birth

MeSH: Brain*, Infant, Premature*, Premature Birth*, Theory of Mind*, Brain Mapping, Child Development, Child, Preschool, Female, Gestational Age, Humans, Magnetic Resonance Imaging, Male (* major topic)

Topic: Child and Animal Learning Development (Developmental and Educational Psychology, Psychology), according to OpenAlex

Funding: Wellcome Trust (108890/Z/15/Z, 218493/Z/19/Z)

Citations: not cited yet (Europe PMC); 97 references in the paper

Abstract

Behavioural studies suggest atypical or delayed development of “theory of mind” (ToM; our ability to reason about others’ mental states) following preterm birth. Using pre-registered analyses of behavioural and movie-viewing functional magnetic resonance imaging (fMRI) metrics of ToM, we tested for a domain-specific impact of preterm birth (24–32 weeks’ gestational age) on theory of mind development at age 5 years. Preterm-born children (n = 52) scored lower than term-born comparators (n = 58) on a linguistic behavioural ToM task, but this difference was primarily driven by differences in receptive language. Neurally, preterm-born children (n = 30) had qualitatively similar responses in brain regions that support ToM reasoning to a short movie to term-born comparators (n = 46), as characterised by four neural metrics; responses to one scene differed as a function of gestational age. Using intersubject correlation analyses, we found that preterm-born children’s ToM network responses were more heterogenous than term-born children’s responses; however, individual preterm-born children’s responses most resembled those observed in same-age term-born children, relative to younger children or other preterm-born children. Taken together, preterm birth does not appear to preclude broadly similar functional development in ToM brain regions by age 5 years.

Reproduced under the paper's license (CC BY), from the paper cited above.

Repositories

Its files are read in the Code ↔ Paper reader above, with 12 matches between paragraphs and lines of code.

hrichardsonlab/fmri-analysis

License: none: the authors keep all their rights

State: the link answers, verified on 27 September 2026

Evidence: files inventoried

Commit: 15a4d88696a4daa910c428d636a1d5ad90c581d5, 10 September 2026

Languages: Python (24), Shell (18), R (1)

Size: 310 files, 43 scripts

Software Heritage: not archived

Found in: “Data and Code Availability”

Holds: README, 1 notebook

Not found: license file, CITATION.cff, environment file, tests, continuous integration, documentation

Tools: NumPy (24 files), pandas (24 files), Nipype (14 files), Nilearn (11 files), NiBabel (9 files), SciPy (8 files), FSL (6 files), PyBIDS (5 files), fMRIPrep (4 files), Dcm2Bids (2 files), FreeSurfer (2 files), ANTs (1 file), Matplotlib (1 file), MRIQC (1 file), scikit-learn (1 file), tedana (1 file), tidyverse (1 file)

Availability: 1 check, the latest on 27 September 2026: the link answers

27 September 2026: the link answers

44 files

scripts/00.setup/setup_project.sh, Shell, 113 lines
scripts/00.setup/symlink_singularities.sh, Shell, 62 lines
scripts/01.bids/bids_conversion.sh, Shell, 261 lines
scripts/01.bids/deface_data.sh, Shell, 117 lines
scripts/02.mriqc/run_mriqc.sh, Shell, 133 lines
scripts/03.freesurfer/run_freesurfer.sh, Shell, 156 lines
scripts/04.fmriprep/denoise_echos.py, Python, 258 lines
scripts/04.fmriprep/run_fmriprep.sh, Shell, 201 lines
scripts/04.fmriprep/run_tedana.sh, Shell, 188 lines
scripts/05.motion_exclusions/check_data.sh, Shell, 112 lines
scripts/05.motion_exclusions/concat_brain_masks.py, Python, 138 lines
scripts/05.motion_exclusions/generate_scanfiles.sh, Shell, 139 lines
scripts/05.motion_exclusions/mark_motion_exclusions.py, Python, 262 lines, 1 match
scripts/06.first_level/calc_psc.py, Python, 339 lines, 1 match
scripts/06.first_level/combine_runs.py, Python, 485 lines
scripts/06.first_level/convert_surface.py, Python, 238 lines
scripts/06.first_level/define_fROIs.py, Python, 309 lines
scripts/06.first_level/delete_firstlevel_outputs.sh, Shell, 120 lines
scripts/06.first_level/extract_stats.py, Python, 566 lines
scripts/06.first_level/firstlevel_pipeline.py, Python, 1,001 lines, 1 match
scripts/06.first_level/generate_eventfiles.sh, Shell, 182 lines
scripts/06.first_level/process_freesurfer_ROI.py, Python, 159 lines
scripts/06.first_level/run_first-level.sh, Shell, 158 lines
scripts/06.first_level/timecourse_pipeline.py, Python, 1,028 lines, 1 match
scripts/07.second_level/label_clusters.py, Python, 315 lines
scripts/07.second_level/reverse_correlation.py, Python, 264 lines, 2 matches
scripts/07.second_level/run_second-level.sh, Shell, 144 lines
scripts/07.second_level/secondlevel_pipeline.py, Python, 517 lines, 1 match
scripts/08.multivariate_analyses/calc_noise_ceiling.py, Python, 328 lines
scripts/08.multivariate_analyses/check_fold_reliability.py, Python, 406 lines
scripts/08.multivariate_analyses/check_roi_reliability.py, Python, 350 lines
scripts/08.multivariate_analyses/compute_neural_rdms.py, Python, 866 lines
scripts/08.multivariate_analyses/correlate_rdms.py, Python, 301 lines
scripts/08.multivariate_analyses/run_multivariate.sh, Shell, 137 lines
scripts/misc/clean_environment.sh, Shell, 53 lines
scripts/misc/compile_rsa_stats.py, Python, 88 lines
scripts/misc/compile_stats.py, Python, 104 lines
scripts/misc/compile_timecourses.py, Python, 127 lines
scripts/misc/get_outlier_info.sh, Shell, 134 lines
scripts/misc/get_run_info.py, Python, 117 lines
scripts/misc/interpolate_timecourses.Rmd, R, 123 lines
scripts/misc/resample_ROIs.py, Python, 111 lines
scripts/misc/run_py-script.sh, Shell, 93 lines
README.md, Text, 35 lines

At the source: github.com/hrichardsonlab/fmri-analysis

OSF xtyu8

License: none: the authors keep all their rights

State: the link answers, verified on 27 September 2026

Evidence: files inventoried

Languages: R (5)

Size: 7 files, 5 scripts

Software Heritage: not checked

Found in: “Data and Code Availability”

Not found: README, license file, CITATION.cff, environment file, tests, continuous integration, documentation

Tools: lmerTest (5 files), tidyverse (4 files), ggplot2 (3 files), lme4 (3 files), patchwork (2 files), brms (1 file), easystats (1 file), reshape2 (1 file)

Availability: 1 check, the latest on 27 September 2026: the link answers (HTTP 200)

27 September 2026: the link answers (HTTP 200)

5 files

Data and Code/Abeletal_PTB-ToM_ResponseType.R, R, 163 lines
Data and Code/Abeletal_PTB-ToM_dosedependency.R, R, 709 lines, 2 matches
Data and Code/Abeletal_PTB-ToM_equivalence.R, R, 642 lines
Data and Code/Abeletal_PTB-ToM_mainAnalyses.R, R, 1,484 lines, 3 matches
Data and Code/Abeletal_SubGroup_analyses.R, R, 333 lines

At the source: osf.io/xtyu8/overview

The paper's code and data availability statement is in the Data section.

Tracing map

Proposed by the machine: these links were found in the paper and verified at the source, without human review. The map will receive a Zenodo DOI once one of the paper's authors has validated it with their ORCID.

What the map holds:

2 repositories of the authors' code, each at its verified commit, with its license and how the link was found in the paper;
48 scripts, each with its path and the digest of its content;
12 matches between paragraphs of the paper and lines of the code (method lexical-v1);
neither the text of the paper nor the code itself.

Its JSON (tracing-map.json) is deposited on Zenodo with its DOI once the map is validated.

Data

Datasets cited

openneuro:ds000228, at OpenNeuro; found in the text, “Regions of interest (ROI) analyses”
osf:w9et8, at OSF; found in the text, “Behavioural “Partly Cloudy” task”

Data and Code Availability

Requests for anonymised data for reproducing the statistical analyses of this study and raw, de-identified (f)MRI data can be made by completing a Data Access Request form at https://reproductive-health.ed.ac.uk/theirworld-edinburgh-birth-cohort-tebc/for-researchers/data-access-and-collaboration. The fMRI analysis pipeline (https://github.com/hrichardsonlab/fmri-analysis) and statistical analysis code (https://osf.io/xtyu8/overview) are publicly available.

Reproduced under the paper's license (CC BY), from the paper cited above.

Versions

The history of this record: each version stored by the harvester or made by a correction of its authors or of the maintainers of its code, and what changed in its facts. The texts of the paper (its abstract, its availability statements) are not part of it; versions that changed only those are not listed.

Version 1, 27 September 2026: the first record

Recorded: type, language, journal, volume, pages, dates, 19 authors, 5 keywords, 12 MeSH terms, 1 funder, 95 references.

Cite

This paper

Abel, S., Thye, M., Mckinnon, K., Smikle, R., Skelton, J., Jiménez-Sánchez, L., Amir, R., Barclay, G., Jardine, C., Mcintyre, D., Hamilton, I., Chua, Y. W., Hosangadi, A., Quigley, A., Batty, G. D., Thrippleton, M. J., Whalley, H. C., Boardman, J. P., & Richardson, H. (2026). Neural and behavioural correlates of theory of mind reasoning in five-year-old children born preterm. Imaging neuroscience (Cambridge, Mass.), 4, IMAG.a.1347. https://doi.org/10.1162/imag.a.1347

BibTeX

@article{abel2026neural, author = {Abel, Selina and Thye, Melissa and Mckinnon, Katie and Smikle, Rebekah and Skelton, Jean and Jiménez-Sánchez, Lorena and Amir, Ray and Barclay, Gayle and Jardine, Charlotte and Mcintyre, Donna and Hamilton, Iona and Chua, Yu Wei and Hosangadi, Aditi and Quigley, Alan and Batty, G David and Thrippleton, Michael J and Whalley, Heather C and Boardman, James P and Richardson, Hilary}, title = {{Neural and behavioural correlates of theory of mind reasoning in five-year-old children born preterm}}, journal = {Imaging neuroscience (Cambridge, Mass.)}, year = {2026}, month = aug, volume = {4}, pages = {IMAG.a.1347}, publisher = {MIT Press}, issn = {2837-6056}, doi = {10.1162/imag.a.1347}, url = {https://doi.org/10.1162/imag.a.1347}, pmid = {42662222}, pmcid = {PMC13519987} }

RIS

TY - JOUR AU - Abel, Selina AU - Thye, Melissa AU - Mckinnon, Katie AU - Smikle, Rebekah AU - Skelton, Jean AU - Jiménez-Sánchez, Lorena AU - Amir, Ray AU - Barclay, Gayle AU - Jardine, Charlotte AU - Mcintyre, Donna AU - Hamilton, Iona AU - Chua, Yu Wei AU - Hosangadi, Aditi AU - Quigley, Alan AU - Batty, G David AU - Thrippleton, Michael J AU - Whalley, Heather C AU - Boardman, James P AU - Richardson, Hilary TI - Neural and behavioural correlates of theory of mind reasoning in five-year-old children born preterm T2 - Imaging neuroscience (Cambridge, Mass.) J2 - Imaging Neurosci (Camb) PY - 2026 DA - 2026/08/26 VL - 4 SP - IMAG.a.1347 SN - 2837-6056 PB - MIT Press DO - 10.1162/imag.a.1347 UR - https://doi.org/10.1162/imag.a.1347 LA - en ER -

CSL-JSON

{ "id": "10.1162/imag.a.1347", "type": "article-journal", "title": "Neural and behavioural correlates of theory of mind reasoning in five-year-old children born preterm", "container-title": "Imaging neuroscience (Cambridge, Mass.)", "author": [ { "family": "Abel", "given": "Selina" }, { "family": "Thye", "given": "Melissa" }, { "family": "Mckinnon", "given": "Katie" }, { "family": "Smikle", "given": "Rebekah" }, { "family": "Skelton", "given": "Jean" }, { "family": "Jiménez-Sánchez", "given": "Lorena" }, { "family": "Amir", "given": "Ray" }, { "family": "Barclay", "given": "Gayle" }, { "family": "Jardine", "given": "Charlotte" }, { "family": "Mcintyre", "given": "Donna" }, { "family": "Hamilton", "given": "Iona" }, { "family": "Chua", "given": "Yu Wei" }, { "family": "Hosangadi", "given": "Aditi" }, { "family": "Quigley", "given": "Alan" }, { "family": "Batty", "given": "G David" }, { "family": "Thrippleton", "given": "Michael J" }, { "family": "Whalley", "given": "Heather C" }, { "family": "Boardman", "given": "James P" }, { "family": "Richardson", "given": "Hilary" } ], "container-title-short": "Imaging Neurosci (Camb)", "volume": "4", "page": "IMAG.a.1347", "DOI": "10.1162/imag.a.1347", "PMID": "42662222", "PMCID": "PMC13519987", "ISSN": "2837-6056", "publisher": "MIT Press", "URL": "https://doi.org/10.1162/imag.a.1347", "language": "en", "issued": { "date-parts": [ [ 2026, 8, 26 ] ] } }

The tracing map gets a citation of its own once an author has validated it and it has a DOI.

Similar papers

The papers with a page that share the most with this one: the tools found in their code, their categories, datasets, cited references and authors, the rarest counting most.

[1] doi:10.1016/j.dcn.2026.101765 [code]: Fusiform face area development correlates with development in higher-order social brain regions.
Journal: Developmental cognitive neuroscience
In common: MRIQC, Dcm2Bids, fMRIPrep, 18 other tools, OpenNeuro ds000228, fMRI, 5 references, author Lorena Jiménez-Sánchez
[2] doi:10.1162/imag.a.1252 [code]: Does the brain's E:I balance really shape long-range temporal correlations? Lessons learned from 3T MRI.
Journal: Imaging neuroscience (Cambridge, Mass.)
In common: MRIQC, Dcm2Bids, fMRIPrep, 12 other tools, fMRI, 1 reference
[3] doi:10.1162/imag.a.1198 [code]: MEPrep: A robust pipeline for multi-echo fMRI denoising and preprocessing.
Journal: Imaging neuroscience (Cambridge, Mass.)
In common: fMRIPrep, tedana, PyBIDS, 9 other tools, fMRI, 3 references
[4] doi:10.1038/s41467-026-72916-5 [code]: Precision fMRI reveals that the language network exhibits adult-like left-hemispheric lateralization by 4 years of age.
Journal: Nature communications
In common: brms, lmerTest, lme4, 2 other tools, fMRI, 6 references, author Hilary Richardson
[5] doi:10.1038/s41467-026-71151-2 [code]: Common and distinct neural correlates of social interaction processing and theory of mind in narratives.
Journal: Nature communications
In common: fMRIPrep, Nipype, ANTs, 9 other tools, 4 references
[6] doi:10.1162/netn.a.547 [code]: An evaluation of the efficacy of single-echo and multi-echo fMRI denoising strategies.
Journal: Network neuroscience (Cambridge, Mass.)
In common: fMRIPrep, tedana, Nipype, 10 other tools, fMRI, 2 references
[7] doi:10.1162/imag.a.1245 [code]: Towards precision EEG connectomics: Evaluating the benefits of dense sampling.
Journal: Imaging neuroscience (Cambridge, Mass.)
In common: Nipype, ANTs, FreeSurfer, 13 other tools
[8] doi:10.1038/s41597-026-06869-1 [code]: Individual Brain Charting: fifth release of high-resolution fMRI data for cognitive mapping.
Journal: Scientific data
In common: PyBIDS, Nipype, ANTs, 9 other tools, fMRI, 2 references
[9] doi:10.1016/j.neuron.2026.04.011 [code]: Precision fMRI reveals densely interdigitated network patches with conserved motifs in the lateral prefrontal cortex.
Journal: Neuron
In common: tedana, ANTs, FreeSurfer, 7 other tools, fMRI, 4 references
[10] doi:10.1002/hbm.70512 [code]: Precision Imaging for Intraindividual Investigation of the Reward Response.
Journal: Human brain mapping
In common: fMRIPrep, easystats, ANTs, 10 other tools, fMRI, 1 reference

Contribute

The authors of this paper can claim it, correct its record and validate its tracing map, and the maintainers of its code (its owner, or a public member of its organization) correct what it says of their repository; anyone signed in can ask for its removal. Every request goes to OSCR's own machine, which answers it; your account page follows them.

Sign in with ORCID to claim this paper as one of its authors, correct its record or validate its tracing map: when the paper's metadata lists your ORCID iD, you are recognized at once. Maintainers of its code: sign in with GitHub, then claim the repository on your account page.

Request its removal

To ask OSCR to remove this record, the copies of its authors' scripts or its tracing map, use the removal request page: signed in, you say who you are, what to remove and why, then review and confirm the request. Published rules decide every request (how).

Discussion, reproductions, activity

Discussion: questions and error reports about this paper and its code, from signed-in readers and its authors. It opens with sign-in.

Reproductions: reports from readers who ran the authors' code: what they reproduced, with which environment, commit and data. It opens with sign-in.

Activity: what happens around this paper: new versions of its record, its map's validation, discussions and reproductions. It opens with sign-in.