Partial Correlation Coefficient of BMI and systolic blood pressure by sex

In Men

library(epicalc)
use(BP_men)
BP_men_complete <- subset(BP_men, !is.na(Body.Mass.Index))
use(BP_men_complete)
# conduct normal linear least-squares regression with BMI as target and age as predictor
regress.BMI.agem = lm(Body.Mass.Index~Age)
summ(Body.Mass.Index)

  obs. mean   median  s.d.   min.   max.  
  1169 28.363 28.247  5.48   14.968 43.929

summ(MeanSBP)

  obs. mean    median  s.d.   min.   max.   
  1169 140.445 137.333 18.87  93.333 222.667

# extract residuals from this regression
residuals.BMI.agem = residuals(regress.BMI.agem)
# conduct normal linear least-squares regression with SBP as target and age as predictor
regress.SBP.agem = lm(MeanSBP~Age)
# extract residuals from this regression
residuals.SBP.agem = residuals(regress.SBP.agem)
library(ggplot2)
plotcc <- data.frame(residuals.BMI.agem,residuals.SBP.agem)
ggplot(plotcc,aes(residuals.BMI.agem, residuals.SBP.agem))+
  geom_point()+
  theme(plot.subtitle = element_text(vjust = 1),
                     plot.caption = element_text(vjust = 1),
                     axis.line = element_line(size = 0.5,
                                              linetype = "solid"), panel.grid.major = element_line(colour = "gray98"),
                     axis.title = element_text(size = 15),
                     panel.background = element_rect(fill = "gray99",
                                                     colour = "white", linetype = "twodash"),
                     plot.background = element_rect(fill = "white"))+
  annotate("text", x=-13, y=80, parse = TRUE,
           label="Men",
           size=10)+
  theme(axis.title = element_text(size = 16), axis.text = element_text(
    colour = "gray0"), axis.text.x = element_text(size = 16), 
    axis.text.y = element_text(size = 15), 
    plot.title = element_text(size = 16, 
                              face = "bold")) + theme(plot.caption = element_text(size = 14, 
    face = "italic", colour = "gray13", hjust = 0), 
    plot.title = element_text(size = 18, 
        hjust = 0.5)) +labs(title = "Partial Correlation Between BMI and SBP controlling for age ", 
    x = "Residuals from Regressing BMI on Age", 
    y = "Residuals from Regressing SBP on Age", 
    caption = "Abbreviations: BMI, Body Mass Index; SBP, systolic blood pressure.")

# no age adjustment
plot(BP_men_complete$Body.Mass.Index, BP_men_complete$MeanSBP)

# use Spearman correlation coefficient to calculate the partial correlation
partial.correlation = cor(residuals.BMI.agem, residuals.SBP.agem, method = 'spearman')
partial.correlation

[1] 0.1536098

# sample size
n = length(residuals.BMI.agem)
# calculate the test statistic and p-value of the Spearman correlation coefficient
test.statistic = partial.correlation*sqrt((n-3)/(1-partial.correlation^2))
test.statistic 

[1] 5.308276

p.value = 2*pt(abs(test.statistic), n-3, lower.tail = F)
p.value

[1] 1.324022e-07

In Women

library(epicalc)
use(BP_women)
BP_women_complete <- subset(BP_women, !is.na(Body.Mass.Index))
use(BP_women_complete)
# conduct normal linear least-squares regression with BMI as target and age as predictor
regress.BMI.age = lm(Body.Mass.Index~Age)
summ(Body.Mass.Index)

  obs. mean   median  s.d.   min.   max.  
  1302 29.059 28.541  6.11   15.52  46.125

summ(MeanSBP)

  obs. mean    median  s.d.   min.   max.  
  1302 135.434 130.333 23.83  89.333 236   

# extract residuals from this regression
residuals.BMI.age = residuals(regress.BMI.age)
# conduct normal linear least-squares regression with SBP as target and age as predictor
regress.SBP.age = lm(MeanSBP~Age)
# extract residuals from this regression
residuals.SBP.age = residuals(regress.SBP.age)
library(ggplot2)
plotcc <- data.frame(residuals.BMI.age,residuals.SBP.age)
ggplot(plotcc,aes(residuals.BMI.age, residuals.SBP.age))+
  geom_point()+
  theme(plot.subtitle = element_text(vjust = 1),
                     plot.caption = element_text(vjust = 1),
                     axis.line = element_line(size = 0.5,
                                              linetype = "solid"), panel.grid.major = element_line(colour = "gray98"),
                     axis.title = element_text(size = 15),
                     panel.background = element_rect(fill = "gray99",
                                                     colour = "white", linetype = "twodash"),
                     plot.background = element_rect(fill = "white"))+
  annotate("text", x=-13, y=80, parse = TRUE,
           label="Women",
           size=10)+
  theme(axis.title = element_text(size = 16), axis.text = element_text(
    colour = "gray0"), axis.text.x = element_text(size = 16), 
    axis.text.y = element_text(size = 15), 
    plot.title = element_text(size = 16, 
                              face = "bold")) + theme(plot.caption = element_text(size = 14, 
    face = "italic", colour = "gray13", hjust = 0), 
    plot.title = element_text(size = 18, 
        hjust = 0.5)) +labs(title = "Partial Correlation Between BMI and SBP controlling for age ", 
    x = "Residuals from Regressing BMI on Age", 
    y = "Residuals from Regressing SBP on Age", 
    caption = "Abbreviations: BMI, Body Mass Index; SBP, systolic blood pressure.")

# no age adjustment
plot(BP_women_complete$Body.Mass.Index, BP_women_complete$MeanSBP)

# use Spearman correlation coefficient to calculate the partial correlation
partial.correlation = cor(residuals.BMI.age, residuals.SBP.age, method = 'spearman')
partial.correlation

[1] 0.2254494

# sample size
n = length(residuals.BMI.age)
# calculate the test statistic and p-value of the Spearman correlation coefficient
test.statistic = partial.correlation*sqrt((n-3)/(1-partial.correlation^2))
test.statistic 

[1] 8.340288

p.value = 2*pt(abs(test.statistic), n-3, lower.tail = F)
p.value

[1] 1.869277e-16