rTMS Study Tracking
Hassan Abdulrasul
2025-10-22
# Libraries
library(tidyr)
library(dplyr)
library(ggplot2)
library(lubridate)
library(plotly)
library(table1)
library(REDCapR)
library(tidyverse)
# Functions
# Replace blank with NA
replace_blank_with_na <- function(x) {
if (is.character(x)) {
x <- na_if(x, "")
}
return(x)
}
my.render.cont <- function(x) {
with(stats.apply.rounding(stats.default(x), digits = 2),
c("Variable",
"Mean (SD)" = sprintf("%s (± %s)", MEAN, SD),
"Median [Min, Max]" = sprintf("%s [%s, %s]", MEDIAN, MIN, MAX)))
}
my.render.cat <- function(x) {
c("Variable", sapply(stats.default(x), function(y)
with(y, sprintf("%d (%0.0f%%)", FREQ, PCT))
))
}
# Plot function with hover text
plot_by_assessment <- function(assessment_name) {
df_plot <- df_long %>% filter(INST == assessment_name)
p <- ggplot(df_plot, aes(
x = timepoint,
y = score,
fill = score_type,
group = score_type
)) +
geom_boxplot(position = position_dodge(width = 0.75), width = 0.6, alpha = 0.5) +
geom_jitter(
aes(text = hover_text),
position = position_jitterdodge(jitter.width = 0.2, dodge.width = 0.75),
size = 1.5,
alpha = 0,
shape = 21,
stroke = 0.2
) +
labs(
title = paste("Score Distributions Across Timepoints:", assessment_name),
x = "Timepoint",
y = "Score",
fill = "Score Type"
) +
theme_minimal(base_size = 14) +
theme(axis.text.x = element_text(angle = 30, hjust = 1)) +
scale_fill_brewer(palette = "Set2")
ggplotly(p, tooltip = "text") %>% layout(boxmode = "group")
}
# mriqc t1w figures
plot_mriqc_T1w_boxplots <- function(df_long, title = "T1w MRIQC Quality Metrics by Timepoint") {
pretty_labels <- c(
cjv = "Coefficient of Joint Variation (CJV)",
cnr = "Contrast-to-Noise Ratio (CNR)",
snr_total = "Signal-to-Noise Ratio (SNR)",
inu_med = "Bias Field Inhomogeneity (INU Median)"
)
df_long <- df_long %>%
group_by(metric, timepoint) %>%
mutate(n = n()) %>%
ungroup() %>%
mutate(
metric_pretty = factor(metric, levels = names(pretty_labels), labels = pretty_labels),
hover_text = paste0(
"Subject: ", subject_id, "<br>",
"Metric: ", pretty_labels[metric], "<br>",
"Value: ", round(value, 2), "<br>",
"n = ", n
)
)
p <- ggplot(df_long, aes(
x = timepoint,
y = value,
fill = timepoint
)) +
geom_boxplot(width = 0.6, alpha = 0.7) +
geom_jitter(
aes(text = hover_text),
position = position_jitter(width = 0.15),
alpha = 0,
size = 1.5
) +
facet_wrap(~ metric_pretty, scales = "free_y") +
labs(
title = title,
x = "Timepoint",
y = "Value"
) +
scale_fill_brewer(palette = "Set2") +
theme_minimal(base_size = 14) +
theme(legend.position = "none")
ggplotly(p, tooltip = "text")
}
plot_mriqc_bold_metrics <- function(df_bold_long, title = "BOLD MRIQC Quality Metrics by Timepoint") {
# Define human-readable metric labels
pretty_labels <- c(
fd_mean = "Mean Framewise Displacement (FD)",
fd_num = "# of Volumes with FD > 0.2mm",
tsnr = "Temporal Signal-to-Noise Ratio (tSNR)",
dvars_std = "Standardized DVARS"
)
# Add group counts and labels
df_bold_long <- df_bold_long %>%
group_by(metric, timepoint) %>%
mutate(n = n()) %>%
ungroup() %>%
mutate(
metric_pretty = factor(metric, levels = names(pretty_labels), labels = pretty_labels),
hover_text = paste0(
"Subject: ", subject_id, "<br>",
"Metric: ", pretty_labels[metric], "<br>",
"Value: ", round(value, 2), "<br>",
"n = ", n
)
)
# Create plot
p <- ggplot(df_bold_long, aes(
x = timepoint,
y = value,
fill = timepoint
)) +
geom_boxplot(width = 0.6, alpha = 0.7) +
geom_jitter(
aes(text = hover_text),
position = position_jitter(width = 0.15),
alpha = 0,
size = 1.5
) +
facet_wrap(~ metric_pretty, scales = "free_y") +
labs(
title = title,
x = "Timepoint",
y = "Value"
) +
scale_fill_brewer(palette = "Set2") +
theme_minimal(base_size = 14) +
theme(legend.position = "none")
ggplotly(p, tooltip = "text")
}
plot_mriqc_dwi_metrics <- function(df_dwi_long, title = "DWI Quality Metrics by Timepoint") {
# Pretty labels
pretty_labels <- c(
fd_mean = "Mean Framewise Displacement (FD)",
ndc = "Neighboring DWI Correlation (NDC)",
spikes_global = "Global Spikes",
snr_cc_shell0 = "SNR (Shell 0)"
)
df_dwi_long <- df_dwi_long %>%
group_by(metric, timepoint) %>%
mutate(n = n()) %>%
ungroup() %>%
mutate(
metric_pretty = factor(metric, levels = names(pretty_labels), labels = pretty_labels),
hover_text = paste0(
"Subject: ", subject_id, "<br>",
"Metric: ", pretty_labels[metric], "<br>",
"Value: ", round(value, 2), "<br>",
"n = ", n
)
)
p <- ggplot(df_dwi_long, aes(
x = timepoint,
y = value,
fill = timepoint
)) +
geom_boxplot(width = 0.6, alpha = 0.7) +
geom_jitter(
aes(text = hover_text),
position = position_jitter(width = 0.15),
alpha = 0,
size = 1.5
) +
facet_wrap(~ metric_pretty, scales = "free_y") +
labs(
title = title,
x = "Timepoint",
y = "Value"
) +
scale_fill_brewer(palette = "Set2") +
theme_minimal(base_size = 14) +
theme(legend.position = "none")
ggplotly(p, tooltip = "text")
}Recruitment
Data wrangling and preperation
# Load up data
#rTMS_Data <- read.csv("C:\\Users\\Hashlu\\Downloads\\RMA01RepetitiveTrans_DATA_2024-10-29_1311.csv")
# Run any pre-processing steps here that make the data readable - e.g, turn blanks "" into NA
# Replace blank with NA
replace_blank_with_na <- function(x) {
if (is.character(x)) {
x <- na_if(x, "")
}
return(x)
}
rTMS_Data <- rTMS_Data %>% mutate(across(everything(), ~ replace_blank_with_na(.)))
# filter out test records
rTMS_Data <- rTMS_Data %>%
filter(!record_id %in% c("test", "Test", "RMA01_CMH_0019"))
## remove record_id 19 it is duplicated
## rtms24 was not allocated to treatment
### Screening
rTMS_screening <- rTMS_Data[grepl("^screening_visit", rTMS_Data$redcap_event_name), ]
# Now we are going to use pivot_wider to take the separate time points from the redcap event column and seperate them into columns that way we can use the summarise function to get a single row that shows the change in scores for the participant
# Reshape
rTMS_screening <- rTMS_screening %>%
pivot_wider(
names_from = redcap_event_name, # Creates new columns named after the unique values in 'redcap_event_name', i.e if the same variable exists in tx1, tx5, etc - a column will be made with the respective timepoint in their name.
values_from = c(hamd_total,hrsd17_total, gaf_rating,cgis_001_cgis, cgis_002_cgii,bsi_score, cssrs_ms_pm , cssrs_freq_pm, srs_totalscore,sbq_totalscore,total_score_adaf6c,rrs_reflection_total,rrs_brooding_total) # list out the variables we care about here (obviously we care about them all though)
)
rTMS_screening_collapsed <- rTMS_screening %>%
group_by(record_id) %>%
summarise_all(~na.omit(.)[1])
rTMS_screening <- rTMS_screening_collapsed %>%
select(
1,
starts_with("hamd_total"),
starts_with("hrsd17_total"),
starts_with("gaf_rating"),
starts_with("cgis_001_cgis"),
starts_with("cgis_002_cgii"),
starts_with("bsi_score"),
starts_with("cssrs_ms_pm"),
starts_with("cssrs_freq_pm"),
starts_with("srs_totalscore"),
starts_with("sbq_totalscore"),
starts_with("total_score_adaf6c"), #beck depression
starts_with("sc_tot_score"), #gad
starts_with("rrs_reflection_total"),
starts_with("rrs_brooding_total"))
### Intervention
rTMS_intervention <- rTMS_Data[grepl("tx[1-9]_arm_1|tx[12][0-9]_arm_1|tx30_arm_1", rTMS_Data$redcap_event_name), ]
rTMS_intervention <- rTMS_intervention %>%
pivot_wider(
names_from = redcap_event_name,
values_from = c(hamd_total,hrsd17_total, gaf_rating,cgis_001_cgis, cgis_002_cgii,bsi_score, cssrs_ms_pm , cssrs_freq_pm, srs_totalscore,sbq_totalscore,total_score_adaf6c,rrs_reflection_total,rrs_brooding_total)
)
rTMS_intervention_collapsed <- rTMS_intervention %>%
group_by(record_id) %>%
summarise_all(~na.omit(.)[1])
rTMS_intervention <- rTMS_intervention_collapsed %>%
select(
1,
starts_with("hamd_total"),
starts_with("hrsd17_total"),
starts_with("gaf_rating"),
starts_with("cgis_001_cgis"),
starts_with("cgis_002_cgii"),
starts_with("bsi_score"),
starts_with("cssrs_ms_pm"),
starts_with("cssrs_freq_pm"),
starts_with("srs_totalscore"),
starts_with("sbq_totalscore"),
starts_with("total_score_adaf6c"),
starts_with("rrs_reflection_total"),
starts_with("rrs_brooding_total"))
### Post
rTMS_post_intervention <- rTMS_Data[grepl("1week_post_interve_arm_1|4weeks_post_interv_arm_1|12weeks_post_inter_arm_1", rTMS_Data$redcap_event_name), ]
rTMS_post_intervention <- rTMS_post_intervention %>%
pivot_wider(
names_from = redcap_event_name,
values_from = c(hamd_total,hrsd17_total, gaf_rating,cgis_001_cgis, cgis_002_cgii,bsi_score, cssrs_ms_pm , cssrs_freq_pm, srs_totalscore,sbq_totalscore,total_score_adaf6c,rrs_reflection_total,rrs_brooding_total)
)
rTMS_post_intervention_collapsed <- rTMS_post_intervention %>%
group_by(record_id) %>%
summarise_all(~na.omit(.)[1])
rTMS_post_intervention <- rTMS_post_intervention_collapsed %>%
select(
1,
starts_with("hamd_total"),
starts_with("hrsd17_total"),
starts_with("gaf_rating"),
starts_with("cgis_001_cgis"),
starts_with("cgis_002_cgii"),
starts_with("bsi_score"),
starts_with("cssrs_ms_pm"),
starts_with("cssrs_freq_pm"),
starts_with("srs_totalscore"),
starts_with("sbq_totalscore"),
starts_with("total_score_adaf6c"),
starts_with("rrs_reflection_total"),
starts_with("rrs_brooding_total"))
## Merge
rTMS_merge <- rTMS_screening %>%
full_join(rTMS_intervention, by = "record_id") %>%
full_join(rTMS_post_intervention, by = "record_id")
# Complete treatment
rTMS_complete <- rTMS_merge %>%
filter(!is.na(rrs_brooding_total_12weeks_post_inter_arm_1))
# also remove cgis.i variables completed by SA
rTMS_complete <- rTMS_complete %>% select(-cgis_001_cgis_sa, -cgis_001_cgis_sa.x, -cgis_001_cgis_sa.y)
rTMS_complete <- rTMS_complete %>% select(-cgis_002_cgii_sa, -cgis_002_cgii_sa.x, -cgis_002_cgii_sa.y)### ScreeningDescriptive Statistics
| Overall (N=37) |
|
|---|---|
| Age (years) | |
| Mean (SD) | 23.5 (5.34) |
| Median [Min, Max] | 23.0 [16.0, 35.0] |
| Missing | 3 (8.1%) |
| Sex | |
| Female | 14 (37.8%) |
| Male | 21 (56.8%) |
| Missing | 2 (5.4%) |
| Race | |
| Hispanic | 2 (5.4%) |
| Not Hispanic or Latino | 32 (86.5%) |
| Missing | 3 (8.1%) |
| Education (years) | |
| Mean (SD) | 14.1 (2.72) |
| Median [Min, Max] | 14.0 [10.0, 20.0] |
| Missing | 3 (8.1%) |
| IQ (Full Scale) | |
| Mean (SD) | 112 (15.4) |
| Median [Min, Max] | 110 [89.0, 144] |
| Missing | 18 (48.6%) |
| IQ Range | |
| 70-84 | 0 (0%) |
| 85-99 | 5 (13.5%) |
| 100-114 | 6 (16.2%) |
| 115-129 | 5 (13.5%) |
| 130-144 | 3 (8.1%) |
| 145-160 | 0 (0%) |
| Missing | 18 (48.6%) |
Distributions
Age
rTMS_demo <- rTMS_demo %>%
filter(!is.na(demo_age_study_entry) & !is.infinite(demo_age_study_entry))
rTMS_age_distribution <- plot_ly(data = rTMS_demo, alpha = 0.6) %>%
add_histogram(
x = ~demo_age_study_entry,
marker = list(color = 'rgba(50, 171, 96, 0.7)'),
xbins = list(
start = min(rTMS_demo$demo_age_study_entry),
end = max(rTMS_demo$demo_age_study_entry),
size = 2
)
) %>%
layout(
barmode = "overlay",
title = "Age Distribution",
xaxis = list(
title = "Age (years)",
tickvals = seq(from = min(rTMS_demo$demo_age_study_entry), to = max(rTMS_demo$demo_age_study_entry), by = 1), # Adjust 'by' to change label frequency
ticktext = seq(from = min(rTMS_demo$demo_age_study_entry), to = max(rTMS_demo$demo_age_study_entry), by = 1) # Adjust 'by' to change label frequency
),
yaxis = list(title = "Count"),
font = list(size = 12),
plot_bgcolor = "#E5ECF6",
paper_bgcolor = "#FFFFFF"
)
rTMS_age_distributionIQ
# Filter to valid IQ values
rTMS_demo <- rTMS_demo %>%
filter(!is.na(iq) & !is.infinite(iq))
# Create IQ Distribution Plot
rTMS_iq_distribution <- plot_ly(data = rTMS_demo, alpha = 0.6) %>%
add_histogram(
x = ~iq,
marker = list(color = 'rgba(50, 171, 96, 0.7)'),
xbins = list(
start = 70,
end = 160,
size = 5 # Adjust bin size as needed
)
) %>%
layout(
barmode = "overlay",
title = "IQ Distribution",
xaxis = list(
title = "Estimated IQ",
tickvals = seq(70, 160, by = 5),
ticktext = seq(70, 160, by = 5)
),
yaxis = list(title = "Count"),
font = list(size = 12),
plot_bgcolor = "#E5ECF6",
paper_bgcolor = "#FFFFFF"
)
rTMS_iq_distributionClinical Scores
Cohort
| Overall (N=37) |
|
|---|---|
| HAMD (17-item total) | |
| Mean (SD) | 12.3 (8.39) |
| Median [Min, Max] | 13.0 [0, 31.0] |
| Missing | 5 (13.5%) |
| GAF (Global Assessment of Functioning) | |
| Mean (SD) | 53.0 (6.31) |
| Median [Min, Max] | 52.5 [40.0, 70.0] |
| Missing | 9 (24.3%) |
| CGI-S (Severity) | |
| 0 - Not assessed | 0 (0%) |
| 1 - Normal, not at all ill | 0 (0%) |
| 2 - Borderline mentally ill | 1 (2.7%) |
| 3 - Mildly ill | 4 (10.8%) |
| 4 - Moderately ill | 15 (40.5%) |
| 5 - Markedly ill | 6 (16.2%) |
| 6 - Severely ill | 0 (0%) |
| 7 - Among the most extremely ill patients | 0 (0%) |
| Missing | 11 (29.7%) |
| BSI (Beck Scale for Suicide Ideation) | |
| Mean (SD) | 6.00 (6.19) |
| Median [Min, Max] | 6.00 [0, 17.0] |
| Missing | 14 (37.8%) |
| CSSR : Most Severe Suicidal Ideation (Past Month) | |
| 1 - Wish to be dead | 2 (5.4%) |
| 2 - Non-specific Active Suicidal Thoughts | 6 (16.2%) |
| 3 - Active Ideation w/o Plan or Intent | 5 (13.5%) |
| 4 - Active Ideation w/ Intent, No Plan | 3 (8.1%) |
| 5 - Active Ideation w/ Specific Plan and Intent | 0 (0%) |
| Missing | 21 (56.8%) |
| CSSR : Frequency of Suicidal Ideation (Past Month) | |
| 1 - Less than once a week | 3 (8.1%) |
| 2 - Once a week | 3 (8.1%) |
| 3 - 2-5 times per week | 4 (10.8%) |
| 4 - Daily or almost daily | 3 (8.1%) |
| 5 - Many times a day | 3 (8.1%) |
| Missing | 21 (56.8%) |
| SRS (Social Responsiveness Scale Total) | |
| Mean (SD) | 28.7 (8.19) |
| Median [Min, Max] | 29.5 [6.00, 42.0] |
| Missing | 9 (24.3%) |
| SBQ-R (Suicidal Behaviors Questionnaire Total) | |
| Mean (SD) | 10.7 (4.41) |
| Median [Min, Max] | 12.0 [3.00, 17.0] |
| Missing | 9 (24.3%) |
| BDI (Beck Depression Inventory Total) | |
| Mean (SD) | 23.9 (15.2) |
| Median [Min, Max] | 25.0 [0, 45.0] |
| Missing | 2 (5.4%) |
| GAD (Generalized Anxiety Disorder Total) | |
| Mean (SD) | 11.0 (4.97) |
| Median [Min, Max] | 11.0 [4.00, 21.0] |
| Missing | 13 (35.1%) |
| RRS Reflection (Rumination Total) | |
| Mean (SD) | 12.4 (3.41) |
| Median [Min, Max] | 12.0 [7.00, 18.0] |
| Missing | 13 (35.1%) |
| RRS Brooding (Rumination Total) | |
| Mean (SD) | 13.6 (3.82) |
| Median [Min, Max] | 14.0 [6.00, 20.0] |
| Missing | 13 (35.1%) |
Baseline (MRI)
| Overall (N=23) |
|
|---|---|
| HAMD (17-item total) | |
| Mean (SD) | 14.5 (7.90) |
| Median [Min, Max] | 16.0 [0, 31.0] |
| GAF (Global Assessment of Functioning) | |
| Mean (SD) | 53.5 (5.84) |
| Median [Min, Max] | 53.0 [44.0, 70.0] |
| Missing | 2 (8.7%) |
| CGI-S (Severity) | |
| 0 - Not assessed | 0 (0%) |
| 1 - Normal, not at all ill | 0 (0%) |
| 2 - Borderline mentally ill | 0 (0%) |
| 3 - Mildly ill | 2 (8.7%) |
| 4 - Moderately ill | 12 (52.2%) |
| 5 - Markedly ill | 5 (21.7%) |
| 6 - Severely ill | 0 (0%) |
| 7 - Among the most extremely ill patients | 0 (0%) |
| Missing | 4 (17.4%) |
| BSI (Beck Scale for Suicide Ideation) | |
| Mean (SD) | 5.89 (5.59) |
| Median [Min, Max] | 6.50 [0, 15.0] |
| Missing | 5 (21.7%) |
| CSSR : Most Severe Suicidal Ideation (Past Month) | |
| 1 - Wish to be dead | 2 (8.7%) |
| 2 - Non-specific Active Suicidal Thoughts | 4 (17.4%) |
| 3 - Active Ideation w/o Plan or Intent | 4 (17.4%) |
| 4 - Active Ideation w/ Intent, No Plan | 3 (13.0%) |
| 5 - Active Ideation w/ Specific Plan and Intent | 0 (0%) |
| Missing | 10 (43.5%) |
| CSSR : Frequency of Suicidal Ideation (Past Month) | |
| 1 - Less than once a week | 3 (13.0%) |
| 2 - Once a week | 2 (8.7%) |
| 3 - 2-5 times per week | 3 (13.0%) |
| 4 - Daily or almost daily | 3 (13.0%) |
| 5 - Many times a day | 2 (8.7%) |
| Missing | 10 (43.5%) |
| SRS (Social Responsiveness Scale Total) | |
| Mean (SD) | 29.7 (7.94) |
| Median [Min, Max] | 30.0 [11.0, 42.0] |
| Missing | 3 (13.0%) |
| SBQ-R (Suicidal Behaviors Questionnaire Total) | |
| Mean (SD) | 11.7 (3.95) |
| Median [Min, Max] | 13.5 [3.00, 16.0] |
| Missing | 3 (13.0%) |
| BDI (Beck Depression Inventory Total) | |
| Mean (SD) | 27.3 (14.0) |
| Median [Min, Max] | 33.0 [0, 45.0] |
| GAD (Generalized Anxiety Disorder Total) | |
| Mean (SD) | 11.2 (4.69) |
| Median [Min, Max] | 11.0 [4.00, 20.0] |
| Missing | 6 (26.1%) |
| RRS Reflection (Rumination Total) | |
| Mean (SD) | 13.1 (3.50) |
| Median [Min, Max] | 14.0 [7.00, 18.0] |
| Missing | 6 (26.1%) |
| RRS Brooding (Rumination Total) | |
| Mean (SD) | 13.8 (3.73) |
| Median [Min, Max] | 14.0 [6.00, 20.0] |
| Missing | 6 (26.1%) |
Treatment 1
| Overall (N=21) |
|
|---|---|
| HAMD (17-item total) | |
| Mean (SD) | 15.8 (6.96) |
| Median [Min, Max] | 16.0 [2.00, 31.0] |
| GAF (Global Assessment of Functioning) | |
| Mean (SD) | 53.8 (6.07) |
| Median [Min, Max] | 53.0 [44.0, 70.0] |
| Missing | 2 (9.5%) |
| CGI-S (Severity) | |
| 0 - Not assessed | 0 (0%) |
| 1 - Normal, not at all ill | 0 (0%) |
| 2 - Borderline mentally ill | 0 (0%) |
| 3 - Mildly ill | 2 (9.5%) |
| 4 - Moderately ill | 12 (57.1%) |
| 5 - Markedly ill | 4 (19.0%) |
| 6 - Severely ill | 0 (0%) |
| 7 - Among the most extremely ill patients | 0 (0%) |
| Missing | 3 (14.3%) |
| BSI (Beck Scale for Suicide Ideation) | |
| Mean (SD) | 6.63 (5.50) |
| Median [Min, Max] | 7.50 [0, 15.0] |
| Missing | 5 (23.8%) |
| CSSR : Most Severe Suicidal Ideation (Past Month) | |
| 1 - Wish to be dead | 2 (9.5%) |
| 2 - Non-specific Active Suicidal Thoughts | 4 (19.0%) |
| 3 - Active Ideation w/o Plan or Intent | 4 (19.0%) |
| 4 - Active Ideation w/ Intent, No Plan | 3 (14.3%) |
| 5 - Active Ideation w/ Specific Plan and Intent | 0 (0%) |
| Missing | 8 (38.1%) |
| CSSR : Frequency of Suicidal Ideation (Past Month) | |
| 1 - Less than once a week | 3 (14.3%) |
| 2 - Once a week | 2 (9.5%) |
| 3 - 2-5 times per week | 3 (14.3%) |
| 4 - Daily or almost daily | 3 (14.3%) |
| 5 - Many times a day | 2 (9.5%) |
| Missing | 8 (38.1%) |
| SRS (Social Responsiveness Scale Total) | |
| Mean (SD) | 29.7 (8.15) |
| Median [Min, Max] | 30.0 [11.0, 42.0] |
| Missing | 2 (9.5%) |
| SBQ-R (Suicidal Behaviors Questionnaire Total) | |
| Mean (SD) | 11.6 (4.02) |
| Median [Min, Max] | 13.0 [3.00, 16.0] |
| Missing | 2 (9.5%) |
| BDI (Beck Depression Inventory Total) | |
| Mean (SD) | 28.9 (13.2) |
| Median [Min, Max] | 33.0 [0, 45.0] |
| GAD (Generalized Anxiety Disorder Total) | |
| Mean (SD) | 11.0 (4.79) |
| Median [Min, Max] | 11.0 [4.00, 20.0] |
| Missing | 5 (23.8%) |
| RRS Reflection (Rumination Total) | |
| Mean (SD) | 13.0 (3.58) |
| Median [Min, Max] | 13.5 [7.00, 18.0] |
| Missing | 5 (23.8%) |
| RRS Brooding (Rumination Total) | |
| Mean (SD) | 14.0 (3.72) |
| Median [Min, Max] | 14.5 [6.00, 20.0] |
| Missing | 5 (23.8%) |
Assessment Completion Status
Compelete Cohort
Baseline MRI
Treatment 1
Cohort Clinical Distributions
Hamilton Hamilton Rating Scale for Depression
Clinical Global Impressions Scale
Global Assessment of Functioning Scale
Beck Scale for Suicide Ideation
Columbia - Suicide Severity Rating Scale
- Wish to be dead
- Non-sepcific Active Suicidal Thoughts
- Active Suicidal Ideation with Any Methods (Not a Plan) without Intent to Act
- Active Suicdal Ideation with Some Intent to Act, without Specific Pan
- Active Suicidal Ideation with Specific Plan and Intent
SRS-Self report
SBQ-R | Suicide Behaviors Questionnaire-Revised
Beck Depression Inventory
Generalized Anxiety Disorder Scale
Ruminative Response Scale
Reflection
Brooding
NIH Toolbox
Picture Vocabulary
Picture Seq Memory
List Sorting Working Memory
Flanker
Change Card Sort
Processing Speed
Oral Reading
Fluid Composite
Crystalized Composite
Total Composite
Early Childhood Composite
MRI metrics
T1-weighted (T1w) Structural MRI
CNR (Contrast-to-Noise Ratio): Reflects GM/WM
contrast.
Higher is better; typical range: 1.5–2.5.
SNR (Signal-to-Noise Ratio): Overall image clarity
relative to background noise.
Typical range: 25–40.
INU Median (Bias Field Inhomogeneity): Measures
intensity non-uniformity; closer to 1 is ideal.
Typical range: 0.95–1.1.
CJV (Coefficient of Joint Variation): GM/WM
intensity overlap; lower is better.
Typical range: 0.5–0.9.
BOLD fMRI
FD Mean (Framewise Displacement): Average head
motion per volume.
<0.2 mm is ideal; 0.1–0.3 mm is typical.
FD Num: Number of volumes with FD > 0.2 mm.
Lower is better; <20 common.
tSNR (Temporal SNR): Stability of voxel signal
across time.
Higher is better; typical range: 50–100.
DVARS (Standardized): Change in signal between
volumes; higher = more motion.
Values near 1 are typical.
DWI (Diffusion-Weighted Imaging)
FD Mean / FD Num: Same as above; motion during
diffusion acquisition.
FD Mean < 0.3 recommended.
NDC (Neighboring DWI Correlation): Spatial
consistency between volumes.
Higher is better; >0.9 ideal.
Spikes Global: Sudden signal artifacts
(motion/hardware).
0 is ideal; 0–2 is common.
SNR (Shell 0): Signal quality in b=0 images.
Typical range: 15–30.
T1w Image
BOLD (Rest)
DWI
Longitudinal checks
hamd_data <- rTMS_complete %>%
select(record_id, starts_with("hamd_"))
hsrd_data <- rTMS_complete %>%
select(record_id, starts_with("hrsd17_total_"))
rTMS_hamilton <- full_join(hamd_data, hsrd_data, by = "record_id")
hamd_columns <- grep("hamd_", names(hamd_data), value = TRUE)
hrsd_columns <- grep("hrsd17_total_", names(hsrd_data), value = TRUE)
for (i in seq_along(hamd_columns)) {
column_name <- sub("hamd_", "", hamd_columns[i])
new_column_name <- paste("hamilton", column_name, sep = "_")
rTMS_hamilton[[new_column_name]] <- coalesce(rTMS_hamilton[[hamd_columns[i]]], rTMS_hamilton[[hrsd_columns[i]]])
}
rTMS_hamilton <- select(rTMS_hamilton, -all_of(c(hamd_columns, hrsd_columns)))
# remove columns that are completely na
rTMS_hamilton <- rTMS_hamilton %>%
select(where(~ any(!is.na(.))))
# Preprocess and rename remaining variables of interest.
rTMS_bsi <-rTMS_complete %>%
select(record_id, starts_with("bsi_score"))
rTMS_bsi <- rTMS_bsi %>%
select(where(~ any(!is.na(.))))
rTMS_cgss <- rTMS_complete %>%
select(record_id, starts_with("cgis_001"))
rTMS_cgss <- rTMS_cgss %>%
select(where(~ any(!is.na(.))))
rTMS_cgsi <-rTMS_complete %>%
select(record_id, starts_with("cgis_002"))
rTMS_cgsi <- rTMS_cgsi %>%
select(where(~ any(!is.na(.))))
#Reshape processed variables to long format for plotting
rTMS_hamilton_plot <- rTMS_hamilton %>%
pivot_longer(
cols = -record_id, # Exclude the record_id from the reshaping
names_to = "timepoint",
values_to = "score"
) %>%
drop_na(score) # Exclude NA values to avoid plotting them
rTMS_bsi_plot <- rTMS_bsi %>%
pivot_longer(
cols = -record_id, # Exclude the record_id from the reshaping
names_to = "timepoint",
values_to = "score"
) %>%
drop_na(score) # Exclude NA values to avoid plotting them
rTMS_cgss_plot <- rTMS_cgss %>%
pivot_longer(
cols = -record_id, # Exclude the record_id from the reshaping
names_to = "timepoint",
values_to = "score"
) %>%
drop_na(score) # Exclude NA values to avoid plotting them
rTMS_cgsi_plot <- rTMS_cgsi %>%
pivot_longer(
cols = -record_id, # Exclude the record_id from the reshaping
names_to = "timepoint",
values_to = "score"
) %>%
drop_na(score) # Exclude NA values to avoid plotting them
# Factorise and relabel time points for plot
rTMS_hamilton_plot$timepoint <- factor(rTMS_hamilton_plot$timepoint,
levels = c(
"hamilton_total_screening_visit_arm_1",
"hamilton_total_tx5_arm_1",
"hamilton_total_tx10_arm_1",
"hamilton_total_tx15_arm_1",
"hamilton_total_tx20_arm_1",
"hamilton_total_tx25_arm_1",
"hamilton_total_tx30_arm_1",
"hamilton_total_1week_post_interve_arm_1",
"hamilton_total_4weeks_post_interv_arm_1",
"hamilton_total_12weeks_post_inter_arm_1"
),
labels = c(
"Screening",
"Session 5",
"Session 10",
"Session 15",
"Session 20",
"Session 25",
"Session 30",
"1 Week Post Treatment",
"4 Weeks Post Treatment",
"12 Weeks Post Treatment"
))
rTMS_bsi_plot$timepoint <- factor(rTMS_bsi_plot$timepoint,
levels = c(
"bsi_score_screening_visit_arm_1",
"bsi_score_tx5_arm_1",
"bsi_score_tx10_arm_1",
"bsi_score_tx15_arm_1",
"bsi_score_tx20_arm_1",
"bsi_score_tx25_arm_1",
"bsi_score_tx30_arm_1",
"bsi_score_1week_post_interve_arm_1",
"bsi_score_4weeks_post_interv_arm_1",
"bsi_score_12weeks_post_inter_arm_1"
),
labels = c(
"Screening",
"Session 5",
"Session 10",
"Session 15",
"Session 20",
"Session 25",
"Session 30",
"1 Week Post Treatment",
"4 Weeks Post Treatment",
"12 Weeks Post Treatment"
))
rTMS_cgss_plot$timepoint <- factor(rTMS_cgss_plot$timepoint,
levels = c(
"cgis_001_cgis_screening_visit_arm_1",
"cgis_001_cgis_tx5_arm_1",
"cgis_001_cgis_tx10_arm_1",
"cgis_001_cgis_tx15_arm_1",
"cgis_001_cgis_tx20_arm_1",
"cgis_001_cgis_tx25_arm_1",
"cgis_001_cgis_tx30_arm_1",
"cgis_001_cgis_1week_post_interve_arm_1",
"cgis_001_cgis_4weeks_post_interv_arm_1",
"cgis_001_cgis_12weeks_post_inter_arm_1"
),
labels = c(
"Screening",
"Session 5",
"Session 10",
"Session 15",
"Session 20",
"Session 25",
"Session 30",
"1 Week Post Treatment",
"4 Weeks Post Treatment",
"12 Weeks Post Treatment"
))
# For rTMS_cgsi_plot (unprocessed)
rTMS_cgsi_plot$timepoint <- factor(rTMS_cgsi_plot$timepoint,
levels = c(
"cgis_002_cgii_tx5_arm_1",
"cgis_002_cgii_tx10_arm_1",
"cgis_002_cgii_tx15_arm_1",
"cgis_002_cgii_tx20_arm_1",
"cgis_002_cgii_tx25_arm_1",
"cgis_002_cgii_tx30_arm_1",
"cgis_002_cgii_1week_post_interve_arm_1",
"cgis_002_cgii_4weeks_post_interv_arm_1",
"cgis_002_cgii_12weeks_post_inter_arm_1"
),
labels = c(
"Session 5",
"Session 10",
"Session 15",
"Session 20",
"Session 25",
"Session 30",
"1 Week Post Treatment",
"4 Weeks Post Treatment",
"12 Weeks Post Treatment"
))Hamilton Rating Scale for Depression
lm_fit_hamilton <- lm(score ~ timepoint, data = rTMS_hamilton_plot)
pred_df_hamilton <- data.frame(timepoint = levels(rTMS_hamilton_plot$timepoint))
pred_df_hamilton$score <- predict(lm_fit_hamilton, newdata = pred_df_hamilton)
pred_df_hamilton$timepoint <- factor(pred_df_hamilton$timepoint, levels = levels(rTMS_hamilton_plot$timepoint))
plotly_hamilton_plot <- plot_ly(
data = rTMS_hamilton_plot,
x = ~timepoint, y = ~score,
type = 'scatter', mode = 'lines+markers',
color = ~as.factor(record_id),
colors = RColorBrewer::brewer.pal(8, "Set1"),
hoverinfo = 'text',
text = ~paste("Record ID:", record_id, "<br>Score:", score, "<br>Timepoint:", timepoint)
) %>%
add_trace(
data = pred_df_hamilton,
x = ~timepoint, y = ~score,
type = 'scatter', mode = 'lines+markers',
line = list(color = 'black', width = 4),
marker = list(symbol = 'x', size = 10),
name = "Main Effect (LM Prediction)",
inherit = FALSE
) %>%
layout(
title = "Hamilton Scores Over Time for Each Record",
xaxis = list(
title = "Timepoint",
tickangle = 45,
categoryorder = "array",
categoryarray = levels(rTMS_hamilton_plot$timepoint) # <-- Force correct order
),
yaxis = list(title = "Score"),
hovermode = 'closest',
autosize = TRUE,
width = 1000,
height = 600
)
plotly_hamilton_plot## Boxplot
mean_df_hamilton <- rTMS_hamilton_plot %>%
group_by(timepoint) %>%
summarise(mean_score = mean(score, na.rm = TRUE)) %>%
ungroup()
mean_df_hamilton$timepoint <- factor(mean_df_hamilton$timepoint, levels = levels(rTMS_hamilton_plot$timepoint))
plotly_hamilton_boxplot <- plot_ly(
data = rTMS_hamilton_plot,
y = ~score, x = ~timepoint,
type = 'box',
color = ~timepoint,
colors = RColorBrewer::brewer.pal(n = 8, name = "Set2"),
boxpoints = "outliers"
) %>%
add_trace(
data = mean_df_hamilton,
x = ~timepoint, y = ~mean_score,
type = 'scatter', mode = 'lines+markers',
line = list(color = 'black', width = 2),
marker = list(color = 'black', symbol = 'x', size = 8),
name = "Mean Score",
inherit = FALSE
) %>%
layout(
title = "Distribution of Hamilton Over Time",
xaxis = list(
title = "Timepoint",
tickangle = 45,
categoryorder = "array",
categoryarray = levels(rTMS_hamilton_plot$timepoint)
),
yaxis = list(title = "Score"),
hovermode = 'closest'
)
plotly_hamilton_boxplotBeck Scale for Suicide Ideation
lm_fit_bsi <- lm(score ~ timepoint, data = rTMS_bsi_plot)
pred_df_bsi <- data.frame(timepoint = levels(rTMS_bsi_plot$timepoint))
pred_df_bsi$score <- predict(lm_fit_bsi, newdata = pred_df_bsi)
pred_df_bsi$timepoint <- factor(pred_df_bsi$timepoint, levels = levels(rTMS_bsi_plot$timepoint))
plotly_bsi_plot <- plot_ly(
data = rTMS_bsi_plot,
x = ~timepoint, y = ~score,
type = 'scatter', mode = 'lines+markers',
color = ~as.factor(record_id),
colors = RColorBrewer::brewer.pal(8, "Set1"),
hoverinfo = 'text',
text = ~paste("Record ID:", record_id, "<br>Score:", score, "<br>Timepoint:", timepoint)
) %>%
add_trace(
data = pred_df_bsi,
x = ~timepoint, y = ~score,
type = 'scatter', mode = 'lines+markers',
line = list(color = 'black', width = 4),
marker = list(symbol = 'x', size = 10),
name = "Main Effect (LM Prediction)",
inherit = FALSE
) %>%
layout(
title = "Beck Suicide Scores Over Time for Each Record",
xaxis = list(
title = "Timepoint",
tickangle = 45,
categoryorder = "array",
categoryarray = levels(rTMS_bsi_plot$timepoint) # <-- Force correct order
),
yaxis = list(title = "Score"),
hovermode = 'closest',
autosize = TRUE,
width = 1000,
height = 600
)
plotly_bsi_plot## Boxplot
mean_df_bsi <- rTMS_bsi_plot %>%
group_by(timepoint) %>%
summarise(mean_score = mean(score, na.rm = TRUE)) %>%
ungroup()
mean_df_bsi$timepoint <- factor(mean_df_bsi$timepoint, levels = levels(rTMS_bsi_plot$timepoint))
plotly_bsi_boxplot <- plot_ly(
data = rTMS_bsi_plot,
y = ~score, x = ~timepoint,
type = 'box',
color = ~timepoint,
colors = RColorBrewer::brewer.pal(n = 8, name = "Set2"),
boxpoints = "outliers"
) %>%
add_trace(
data = mean_df_bsi,
x = ~timepoint, y = ~mean_score,
type = 'scatter', mode = 'lines+markers',
line = list(color = 'black', width = 2),
marker = list(color = 'black', symbol = 'x', size = 8),
name = "Mean Score",
inherit = FALSE
) %>%
layout(
title = "Distribution of Beck Suicide Scores Over Time",
xaxis = list(
title = "Timepoint",
tickangle = 45,
categoryorder = "array",
categoryarray = levels(rTMS_bsi_plot$timepoint)
),
yaxis = list(title = "Score"),
hovermode = 'closest'
)
plotly_bsi_boxplotClinical Global (severity) Impressions Scale
plotly_cgss_plot <- plot_ly(data = rTMS_cgss_plot, x = ~timepoint, y = ~score,
type = 'scatter', mode = 'lines+markers',
color = ~as.factor(record_id), colors = RColorBrewer::brewer.pal(8, "Paired"), # Using "Paired" palette for distinct color
hoverinfo = 'text',
text = ~paste("Record ID:", record_id, "<br>Score:", score, "<br>Timepoint:", timepoint)) %>%
layout(title = "CGI-S Scores Over Time for Each Record",
xaxis = list(title = "Timepoint", tickangle = 45, tickmode = "auto"), # Auto tick mode for dynamic adjustment
yaxis = list(title = "Score"),
hovermode = 'closest',
autosize = TRUE,
width = 1000,
height = 600)
plotly_cgss_plot## Boxplot
plotly_cgss_boxplot <- plot_ly(data = rTMS_cgss_plot, y = ~score, x = ~timepoint,
type = 'box',
color = ~timepoint, # Color by timepoint
colors = RColorBrewer::brewer.pal(n = 8, name = "Set2")) %>%
layout(title = "Distribution of CGS-S Over Time",
xaxis = list(title = "Timepoint", tickangle = 45), # Rotate x-axis labels for better readability
yaxis = list(title = "Score"),
hovermode = 'closest') %>%
add_boxplot(width = 0.7) # Adjust box width to 70% of the categorical width
plotly_cgss_boxplotClinical Global (Improvement) Impressions Scale
plotly_cgsi_plot <- plot_ly(data = rTMS_cgsi_plot, x = ~timepoint, y = ~score,
type = 'scatter', mode = 'lines+markers',
color = ~as.factor(record_id), colors = RColorBrewer::brewer.pal(8, "Set3"), # Using vibrant colors for distinction
hoverinfo = 'text',
text = ~paste("Record ID:", record_id, "<br>Score:", score, "<br>Timepoint:", timepoint)) %>%
layout(title = "CGI-I Scores Over Time for Each Record",
xaxis = list(title = "Timepoint", tickangle = 45, tickmode = "auto"), # Auto adjust ticks based on data
yaxis = list(title = "Score", tickmode = "array", tickvals = unique(rTMS_cgsi_plot$score), dtick = 1), # Ensure only integers on y-axis
hovermode = 'closest',
autosize = TRUE,
width = 1000,
height = 600)
plotly_cgsi_plot## Boxplot
plotly_cgsi_boxplot <- plot_ly(data = rTMS_cgsi_plot, y = ~score, x = ~timepoint,
type = 'box',
color = ~timepoint, # Color by timepoint
colors = RColorBrewer::brewer.pal(n = 8, name = "Set2")) %>%
layout(title = "Distribution of CGS-I Over Time",
xaxis = list(title = "Timepoint", tickangle = 45), # Rotate x-axis labels for better readability
yaxis = list(title = "Score"),
hovermode = 'closest') %>%
add_boxplot(width = 0.7) # Adjust box width to 70% of the categorical width
plotly_cgsi_boxplot# recruited between April 1, 2024 - March 31, 2025
Participants_consented_rtms$consent_sig_date <- as.Date(Participants_consented_rtms$consent_sig_date)
# Define start and end dates
start_date <- as.Date("2024-04-01")
end_date <- as.Date("2025-03-31")
# Filter rows based on the recruitment date range
new_recruits <- Participants_consented_rtms[Participants_consented_rtms$consent_sig_date >= start_date &
Participants_consented_rtms$consent_sig_date <= end_date, ]