17 The WCGS
17.1 Setup: Packages Used Here
We will also use the favstats
function from the mosaic
package, even though I won’t load mosaic
here.
17.2 The Western Collaborative Group Study (wcgs
)
Vittinghoff et al. (2012) explore data from the Western Collaborative Group Study (WCGS) in some detail1. We’ll touch lightly on some key issues in this Chapter.
The Western Collaborative Group Study (WCGS) was designed to test the hypothesis that the so-called Type A behavior pattern (TABP) - “characterized particularly by excessive drive, aggressiveness, and ambition, frequently in association with a relatively greater preoccupation with competitive activity, vocational deadlines, and similar pressures” - is a cause of coronary heart disease (CHD). Two additional goals, developed later in the study, were (1) to investigate the comparability of formulas developed in WCGS and in the Framingham Study (FS) for prediction of CHD risk, and (2) to determine how addition of TABP to an existing multivariate prediction formula affects ability to select subjects for intervention programs.
The study enrolled over 3,000 men ages 39-59 who were employed in San Francisco or Los Angeles, during 1960 and 1961.
In the code chunk below, after importing the data and creating a tibble with read_csv
, I used mutate(across(where(is.character), as_factor)
to convert all variables containing character data into factors.
# A tibble: 3,154 × 22
id age agec height weight lnwght wghtcat bmi sbp lnsbp dbp chol
<dbl> <dbl> <fct> <dbl> <dbl> <dbl> <fct> <dbl> <dbl> <dbl> <dbl> <dbl>
1 2343 50 46-50 67 200 5.30 170-200 31.3 132 4.88 90 249
2 3656 51 51-55 73 192 5.26 170-200 25.3 120 4.79 74 194
3 3526 59 56-60 70 200 5.30 170-200 28.7 158 5.06 94 258
4 22057 51 51-55 69 150 5.01 140-170 22.1 126 4.84 80 173
5 12927 44 41-45 71 160 5.08 140-170 22.3 126 4.84 80 214
6 16029 47 46-50 64 158 5.06 140-170 27.1 116 4.75 76 206
7 3894 40 35-40 70 162 5.09 140-170 23.2 122 4.80 78 190
8 11389 41 41-45 70 160 5.08 140-170 23.0 130 4.87 84 212
9 12681 50 46-50 71 195 5.27 170-200 27.2 112 4.72 70 130
10 10005 43 41-45 68 187 5.23 170-200 28.4 120 4.79 80 233
# ℹ 3,144 more rows
# ℹ 10 more variables: behpat <fct>, dibpat <fct>, smoke <fct>, ncigs <dbl>,
# arcus <dbl>, chd69 <fct>, typchd69 <dbl>, time169 <dbl>, t1 <dbl>,
# uni <dbl>
Here, we have 3154 rows (subjects) and 22 columns (variables).
17.2.1 Structure of wcgs
We can specify the (sometimes terrible) variable names, through the names
function, or we can add other elements of the structure, so that we can identify items of particular interest.
str(wcgs)
tibble [3,154 × 22] (S3: tbl_df/tbl/data.frame)
$ id : num [1:3154] 2343 3656 3526 22057 12927 ...
$ age : num [1:3154] 50 51 59 51 44 47 40 41 50 43 ...
$ agec : Factor w/ 5 levels "46-50","51-55",..: 1 2 3 2 4 1 5 4 1 4 ...
$ height : num [1:3154] 67 73 70 69 71 64 70 70 71 68 ...
$ weight : num [1:3154] 200 192 200 150 160 158 162 160 195 187 ...
$ lnwght : num [1:3154] 5.3 5.26 5.3 5.01 5.08 ...
$ wghtcat : Factor w/ 4 levels "170-200","140-170",..: 1 1 1 2 2 2 2 2 1 1 ...
$ bmi : num [1:3154] 31.3 25.3 28.7 22.1 22.3 ...
$ sbp : num [1:3154] 132 120 158 126 126 116 122 130 112 120 ...
$ lnsbp : num [1:3154] 4.88 4.79 5.06 4.84 4.84 ...
$ dbp : num [1:3154] 90 74 94 80 80 76 78 84 70 80 ...
$ chol : num [1:3154] 249 194 258 173 214 206 190 212 130 233 ...
$ behpat : Factor w/ 4 levels "A1","A2","B3",..: 1 1 1 1 1 1 1 1 1 1 ...
$ dibpat : Factor w/ 2 levels "Type A","Type B": 1 1 1 1 1 1 1 1 1 1 ...
$ smoke : Factor w/ 2 levels "Yes","No": 1 1 2 2 2 1 2 1 2 1 ...
$ ncigs : num [1:3154] 25 25 0 0 0 80 0 25 0 25 ...
$ arcus : num [1:3154] 1 0 1 1 0 0 0 0 1 0 ...
$ chd69 : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 1 1 1 ...
$ typchd69: num [1:3154] 0 0 0 0 0 0 0 0 0 0 ...
$ time169 : num [1:3154] 1367 2991 2960 3069 3081 ...
$ t1 : num [1:3154] -1.63 -4.06 0.64 1.12 2.43 ...
$ uni : num [1:3154] 0.486 0.186 0.728 0.624 0.379 ...
17.2.2 Codebook for wcgs
This table was lovingly hand-crafted, and involved a lot of typing. We’ll look for better ways in 432.
Name | Stored As | Type | Details (units, levels, etc.) |
---|---|---|---|
id |
integer | (nominal) | ID #, nominal and uninteresting |
age |
integer | quantitative | age, in years - no decimal places |
agec |
factor (5) | (ordinal) | age: 35-40, 41-45, 46-50, 51-55, 56-60 |
height |
integer | quantitative | height, in inches |
weight |
integer | quantitative | weight, in pounds |
lnwght |
number | quantitative | natural logarithm of weight |
wghtcat |
factor (4) | (ordinal) | wt: < 140, 140-170, 170-200, > 200 |
bmi |
number | quantitative | body-mass index: 703 * weight in lb / (height in in)2 |
sbp |
integer | quantitative | systolic blood pressure, in mm Hg |
lnsbp |
number | quantitative | natural logarithm of sbp |
dbp |
integer | quantitative | diastolic blood pressure, mm Hg |
chol |
integer | quantitative | total cholesterol, mg/dL |
behpat |
factor (4) | (nominal) | behavioral pattern: A1, A2, B3 or B4 |
dibpat |
factor (2) | (binary) | behavioral pattern: A or B |
smoke |
factor (2) | (binary) | cigarette smoker: Yes or No |
ncigs |
integer | quantitative | number of cigarettes smoked per day |
arcus |
integer | (nominal) | arcus senilis present (1) or absent (0) |
chd69 |
factor (2) | (binary) | CHD event: Yes or No |
typchd69 |
integer | (4 levels) | event: 0 = no CHD, 1 = MI or SD, 2 = silent MI, 3 = angina |
time169 |
integer | quantitative | follow-up time in days |
t1 |
number | quantitative | heavy-tailed (random draws) |
uni |
number | quantitative | light-tailed (random draws) |
17.2.3 Quick Summary
summary(wcgs)
id age agec height weight
Min. : 2001 Min. :39.00 46-50: 750 Min. :60.00 Min. : 78
1st Qu.: 3741 1st Qu.:42.00 51-55: 528 1st Qu.:68.00 1st Qu.:155
Median :11406 Median :45.00 56-60: 242 Median :70.00 Median :170
Mean :10478 Mean :46.28 41-45:1091 Mean :69.78 Mean :170
3rd Qu.:13115 3rd Qu.:50.00 35-40: 543 3rd Qu.:72.00 3rd Qu.:182
Max. :22101 Max. :59.00 Max. :78.00 Max. :320
lnwght wghtcat bmi sbp lnsbp
Min. :4.357 170-200:1171 Min. :11.19 Min. : 98.0 Min. :4.585
1st Qu.:5.043 140-170:1538 1st Qu.:22.96 1st Qu.:120.0 1st Qu.:4.787
Median :5.136 > 200 : 213 Median :24.39 Median :126.0 Median :4.836
Mean :5.128 < 140 : 232 Mean :24.52 Mean :128.6 Mean :4.850
3rd Qu.:5.204 3rd Qu.:25.84 3rd Qu.:136.0 3rd Qu.:4.913
Max. :5.768 Max. :38.95 Max. :230.0 Max. :5.438
dbp chol behpat dibpat smoke
Min. : 58.00 Min. :103.0 A1: 264 Type A:1589 Yes:1502
1st Qu.: 76.00 1st Qu.:197.2 A2:1325 Type B:1565 No :1652
Median : 80.00 Median :223.0 B3:1216
Mean : 82.02 Mean :226.4 B4: 349
3rd Qu.: 86.00 3rd Qu.:253.0
Max. :150.00 Max. :645.0
NA's :12
ncigs arcus chd69 typchd69 time169
Min. : 0.0 Min. :0.0000 No :2897 Min. :0.0000 Min. : 18
1st Qu.: 0.0 1st Qu.:0.0000 Yes: 257 1st Qu.:0.0000 1st Qu.:2842
Median : 0.0 Median :0.0000 Median :0.0000 Median :2942
Mean :11.6 Mean :0.2985 Mean :0.1363 Mean :2684
3rd Qu.:20.0 3rd Qu.:1.0000 3rd Qu.:0.0000 3rd Qu.:3037
Max. :99.0 Max. :1.0000 Max. :3.0000 Max. :3430
NA's :2
t1 uni
Min. :-47.43147 Min. :0.0007097
1st Qu.: -1.00337 1st Qu.:0.2573755
Median : 0.00748 Median :0.5157779
Mean : -0.03336 Mean :0.5052159
3rd Qu.: 0.97575 3rd Qu.:0.7559902
Max. : 47.01623 Max. :0.9994496
NA's :39
For a more detailed description, we might consider Hmisc::describe
, psych::describe
, mosaic::inspect
, etc., as we’ve done (for instance) in Chapter 3 and Chapter 7.
17.3 Are the SBPs Normally Distributed?
Consider the question of whether the distribution of the systolic blood pressure results is well-approximated by the Normal, where we’ll make use of tools based on our discussion in Chapter 11.
res <- mosaic::favstats(~ sbp, data = wcgs)
Registered S3 method overwritten by 'mosaic':
method from
fortify.SpatialPolygonsDataFrame ggplot2
bin_w <- 5 # specify binwidth
ggplot(wcgs, aes(x = sbp)) +
geom_histogram(binwidth = bin_w,
fill = "orchid",
col = "blue") +
stat_function(
fun = function(x) dnorm(x, mean = res$mean,
sd = res$sd) *
res$n * bin_w,
col = "navy") +
labs(title = "Systolic BP for `wcgs` subjects",
x = "Systolic BP (mm Hg)", y = "",
caption = "Superimposed Normal model")
Since the data contain both sbp
and lnsbp
(its natural logarithm), let’s compare them. Note that in preparing the graph, we’ll need to change the location for the text annotation.
res <- mosaic::favstats(~ lnsbp, data = wcgs)
bin_w <- 0.05 # specify binwidth
ggplot(wcgs, aes(x = lnsbp)) +
geom_histogram(binwidth = bin_w,
fill = "orange",
col = "blue") +
stat_function(
fun = function(x) dnorm(x, mean = res$mean,
sd = res$sd) *
res$n * bin_w,
col = "navy") +
labs(title = "ln(Systolic BP) for `wcgs` subjects",
x = "ln(Systolic BP)", y = "",
caption = "Superimposed Normal model")
We can also look at Normal Q-Q plots, for instance…
p1 <- ggplot(wcgs, aes(sample = sbp)) +
geom_qq(color = "orchid") +
geom_qq_line(color = "red") +
labs(y = "Ordered SBP", title = "sbp in wcgs")
p2 <- ggplot(wcgs, aes(sample = lnsbp)) +
geom_qq(color = "orange") +
geom_qq_line(color = "red") +
labs(y = "Ordered ln(SBP)", title = "ln(sbp) in wcgs")
## next step requires library(patchwork)
p1 + p2 +
plot_annotation(title = "Normal Q-Q plots of SBP and ln(SBP) in wcgs")
There’s at best a small improvement from sbp
to lnsbp
in terms of approximation by a Normal distribution.
17.4 Identifying and Describing SBP outliers
It looks like there’s an outlier (or a series of them) in the SBP data.
ggplot(wcgs, aes(x = "", y = sbp)) +
geom_violin() +
geom_boxplot(width = 0.3, fill = "royalblue",
outlier.color = "royalblue") +
labs(title = "Boxplot with Violin of SBP in `wcgs` data",
y = "Systolic Blood Pressure (mm Hg)",
x = "") +
coord_flip()
mosaic::favstats(wcgs$sbp)
min Q1 median Q3 max mean sd n missing
98 120 126 136 230 128.6328 15.11773 3154 0
Hmisc::describe(wcgs$sbp)
wcgs$sbp
n missing distinct Info Mean Gmd .05 .10
3154 0 62 0.996 128.6 16.25 110 112
.25 .50 .75 .90 .95
120 126 136 148 156
lowest : 98 100 102 104 106, highest: 200 208 210 212 230
The maximum value here is 230, and is clearly the most extreme value in the data set. One way to gauge this is to describe that observation’s Z score, the number of standard deviations away from the mean that the observation falls. Here, the maximum value, 230 is 6.71 standard deviations above the mean, and thus has a Z score of 6.7.
A negative Z score would indicate a point below the mean, while a positive Z score indicates, as we’ve seen, a point above the mean. The minimum systolic blood pressure, 98 is 2.03 standard deviations below the mean, so it has a Z score of -2.
Recall that the Empirical Rule (described in Chapter 11) suggests that if a variable follows a Normal distribution, it would have approximately 95% of its observations falling inside a Z score of (-2, 2), and 99.74% falling inside a Z score range of (-3, 3). Do the systolic blood pressures appear Normally distributed?
17.5 Does Weight Category Relate to SBP?
The data are collected into four groups based on the subject’s weight (in pounds).
ggplot(wcgs, aes(x = wghtcat, y = sbp)) +
geom_violin() +
geom_boxplot(aes(fill = wghtcat), width = 0.3, notch = TRUE) +
scale_fill_viridis_d() +
guides(fill = "none") +
labs(title = "Boxplot of Systolic BP by Weight Category in WCGS",
x = "Weight Category", y = "Systolic Blood Pressure")
17.6 Re-Leveling a Factor
Well, that’s not so good. We really want those weight categories (the levels) to be ordered more sensibly.
wcgs |> tabyl(wghtcat)
wghtcat n percent
170-200 1171 0.37127457
140-170 1538 0.48763475
> 200 213 0.06753329
< 140 232 0.07355739
Like all factor variables in R, the categories are specified as levels. We want to change the order of the levels in a new version of this factor variable so they make sense. There are multiple ways to do this, but I prefer the fct_relevel
function from the forcats
package (part of the tidyverse.) Which order is more appropriate?
I’ll add a new variable to the wcgs
data called weight_f
that relevels the wghtcat
data.
wcgs <- wcgs |>
mutate(weight_f = fct_relevel(wghtcat, "< 140", "140-170", "170-200", "> 200"))
wcgs |> tabyl(weight_f)
weight_f n percent
< 140 232 0.07355739
140-170 1538 0.48763475
170-200 1171 0.37127457
> 200 213 0.06753329
For more on the forcats
package, check out Hadley Wickham and Grolemund (2023), especially its section on Factors.
17.6.1 SBP by Weight Category
ggplot(wcgs, aes(x = weight_f, y = sbp, fill = weight_f)) +
geom_boxplot(notch = TRUE) +
scale_fill_viridis_d() +
guides(fill = "none") +
labs(title = "Systolic Blood Pressure by Reordered Weight Category in WCGS",
x = "Weight Category", y = "Systolic Blood Pressure")
We might see some details well with a ridgeline plot, too.
ggplot(wcgs, aes(x = sbp, y = weight_f, fill = weight_f, height = ..density..)) +
ggridges::geom_density_ridges(scale = 2) +
scale_fill_viridis_d() +
guides(fill = "none") +
labs(title = "SBP by Weight Category (wcgs)",
x = "Systolic Blood Pressure",
y = "Weight Category")
Warning: The dot-dot notation (`..density..`) was deprecated in ggplot2 3.4.0.
ℹ Please use `after_stat(density)` instead.
Picking joint bandwidth of 3.74
As the plots suggest, patients in the heavier groups generally had higher systolic blood pressures.
mosaic::favstats(sbp ~ weight_f, data = wcgs)
weight_f min Q1 median Q3 max mean sd n missing
1 < 140 98 112 120 130 196 123.1379 14.73394 232 0
2 140-170 100 118 124 134 192 126.2939 13.65294 1538 0
3 170-200 100 120 130 140 230 131.1136 15.57024 1171 0
4 > 200 110 126 132 150 212 137.8685 16.75522 213 0
17.7 Are Weight and SBP Linked?
Let’s build a scatter plot of SBP (Outcome) by Weight (Predictor), rather than breaking down into categories.
ggplot(wcgs, aes(x = weight, y = sbp)) +
geom_point(size=3, shape=1, color="forestgreen") + ## default size = 2
geom_smooth(method = "lm", se = FALSE, col = "red", formula = y ~ x) +
geom_smooth(method = "loess", col = "blue", formula = y ~ x) +
ggtitle("SBP vs. Weight in 3,154 WCGS Subjects")
- The mass of the data is hidden from us - showing 3154 points in one plot can produce little more than a blur where there are lots of points on top of each other.
- Here the least squares regression line (in red), and loess scatterplot smoother, (in blue) can help.
The relationship between systolic blood pressure and weight appears to be very close to linear, but of course there is considerable scatter around that generally linear relationship. It turns out that the Pearson correlation of these two variables is 0.253.
17.8 SBP and Weight by Arcus Senilis groups?
An issue of interest to us will be to assess whether the SBP-Weight relationship we see above is similar among subjects who have been diagnosed with arcus senilis and those who have not.
Arcus senilis is an old age syndrome where there is a white, grey, or blue opaque ring in the corneal margin (peripheral corneal opacity), or white ring in front of the periphery of the iris. It is present at birth but then fades; however, it is quite commonly present in the elderly. It can also appear earlier in life as a result of hypercholesterolemia.
Wikipedia article on Arcus Senilis, retrieved 2017-08-15
Let’s start with a quick look at the arcus
data.
wcgs |> tabyl(arcus)
arcus n percent valid_percent
0 2211 0.7010145847 0.7014594
1 941 0.2983512999 0.2985406
NA 2 0.0006341154 NA
We have 2 missing values, so we probably want to do something about that before plotting the data, and we may also want to create a factor variable with more meaningful labels than 1 (which means yes, arcus senilis is present) and 0 (which means no, it isn’t.)
wcgs <- wcgs |>
mutate(arcus_f = fct_recode(factor(arcus),
"Arcus senilis" = "1",
"No arcus senilis" = "0"),
arcus_f = fct_relevel(arcus_f, "Arcus senilis"))
wcgs |> tabyl(arcus_f, arcus)
arcus_f 0 1 NA_
Arcus senilis 0 941 0
No arcus senilis 2211 0 0
<NA> 0 0 2
Let’s build a version of the wcgs
data that eliminates all missing data in the variables of immediate interest, and then plot the SBP-weight relationship in groups of patients with and without arcus senilis.
wcgs_temp <- wcgs |>
filter(complete.cases(arcus_f, sbp, weight))
ggplot(wcgs_temp, aes(x = weight, y = sbp, group = arcus_f)) +
geom_point(shape = 1) +
geom_smooth(method = "lm", col = "red", formula = y ~ x) +
geom_smooth(method = "loess", se = FALSE, col = "blue", formula = y ~ x) +
labs(title = "SBP vs. Weight by Arcus Senilis status",
caption = "3,152 WCGS with known arcus senilis status") +
facet_wrap(~ arcus_f)
17.9 Linear Model for SBP-Weight Relationship: subjects without Arcus Senilis
model.noarcus <-
lm(sbp ~ weight, data = filter(wcgs, arcus == 0))
tidy(model.noarcus) |>
kbl(digits = 2) |>
kable_styling(full_width = FALSE)
term | estimate | std.error | statistic | p.value |
---|---|---|---|---|
(Intercept) | 95.92 | 2.56 | 37.54 | 0 |
weight | 0.19 | 0.01 | 12.77 | 0 |
glance(model.noarcus) |>
select(r.squared:p.value, AIC) |>
kbl(digits = c(3, 3, 1, 1, 3, 0)) |>
kable_styling(full_width = FALSE)
r.squared | adj.r.squared | sigma | statistic | p.value | AIC |
---|---|---|---|---|---|
0.069 | 0.068 | 14.8 | 163 | 0 | 18194 |
summary(model.noarcus)
Call:
lm(formula = sbp ~ weight, data = filter(wcgs, arcus == 0))
Residuals:
Min 1Q Median 3Q Max
-29.011 -10.251 -2.447 7.553 99.848
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 95.9219 2.5552 37.54 <2e-16 ***
weight 0.1902 0.0149 12.77 <2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 14.8 on 2209 degrees of freedom
Multiple R-squared: 0.0687, Adjusted R-squared: 0.06828
F-statistic: 163 on 1 and 2209 DF, p-value: < 2.2e-16
The linear model for the 2211 patients without Arcus Senilis has R-squared = 6.87%.
- The regression equation is 95.92 - 0.19 weight, for those patients without Arcus Senilis.
17.10 Linear Model for SBP-Weight Relationship: subjects with Arcus Senilis
model.witharcus <-
lm(sbp ~ weight, data = filter(wcgs, arcus == 1))
tidy(model.witharcus) |>
kbl(digits = 2) |>
kable_styling(full_width = FALSE)
term | estimate | std.error | statistic | p.value |
---|---|---|---|---|
(Intercept) | 101.88 | 3.76 | 27.13 | 0 |
weight | 0.16 | 0.02 | 7.39 | 0 |
glance(model.witharcus) |>
select(r.squared:p.value, AIC) |>
kbl(digits = c(3, 3, 1, 1, 3, 0)) |>
kable_styling(full_width = FALSE)
r.squared | adj.r.squared | sigma | statistic | p.value | AIC |
---|---|---|---|---|---|
0.055 | 0.054 | 14.2 | 54.6 | 0 | 7667 |
summary(model.witharcus)
Call:
lm(formula = sbp ~ weight, data = filter(wcgs, arcus == 1))
Residuals:
Min 1Q Median 3Q Max
-30.335 -9.636 -1.961 7.973 76.738
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 101.87847 3.75572 27.126 < 2e-16 ***
weight 0.16261 0.02201 7.388 3.29e-13 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 14.19 on 939 degrees of freedom
Multiple R-squared: 0.05494, Adjusted R-squared: 0.05393
F-statistic: 54.58 on 1 and 939 DF, p-value: 3.29e-13
The linear model for the 941 patients with Arcus Senilis has R-squared = 5.49%.
- The regression equation is 101.88 - 0.163 weight, for those patients with Arcus Senilis.
17.11 Including Arcus Status in the model
model3 <- lm(sbp ~ weight * arcus, data = filter(wcgs, !is.na(arcus)))
tidy(model3) |>
kbl(digits = 2) |>
kable_styling(full_width = FALSE)
term | estimate | std.error | statistic | p.value |
---|---|---|---|---|
(Intercept) | 95.92 | 2.52 | 38.00 | 0.00 |
weight | 0.19 | 0.01 | 12.92 | 0.00 |
arcus | 5.96 | 4.62 | 1.29 | 0.20 |
weight:arcus | -0.03 | 0.03 | -1.02 | 0.31 |
glance(model3) |>
select(r.squared:p.value, AIC) |>
kbl(digits = c(3, 3, 1, 1, 3, 0)) |>
kable_styling(full_width = FALSE)
r.squared | adj.r.squared | sigma | statistic | p.value | AIC |
---|---|---|---|---|---|
0.066 | 0.065 | 14.6 | 74.1 | 0 | 25861 |
summary(model3)
Call:
lm(formula = sbp ~ weight * arcus, data = filter(wcgs, !is.na(arcus)))
Residuals:
Min 1Q Median 3Q Max
-30.335 -10.152 -2.349 7.669 99.848
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 95.92190 2.52440 37.998 <2e-16 ***
weight 0.19017 0.01472 12.921 <2e-16 ***
arcus 5.95657 4.61972 1.289 0.197
weight:arcus -0.02756 0.02703 -1.019 0.308
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 14.62 on 3148 degrees of freedom
Multiple R-squared: 0.06595, Adjusted R-squared: 0.06506
F-statistic: 74.09 on 3 and 3148 DF, p-value: < 2.2e-16
The actual regression equation in this setting includes both weight, and an indicator variable (1 = yes, 0 = no) for arcus senilis status, and the product term combining weight and that 1/0 indicator. In 432, we’ll spend substantial time and energy discussing these product terms, but we’ll not do much of that in 431.
- Note the use of the product term
weight*arcus
in the setup of the model to allow both the slope of weight and the intercept term in the model to change depending on arcus senilis status.- For a patient who has arcus, the regression equation is SBP = 95.92 + 0.19 weight + 5.96 (1) - 0.028 weight (1) = 101.88 + 0.162 weight.
- For a patient without arcus senilis, the regression equation is SBP = 95.92 + 0.19 weight + 5.96 (0) - 0.028 weight (0) = 95.92 + 0.19 weight.
The linear model including the interaction of weight and arcus to predict sbp for the 3152 patients with known Arcus Senilis status has R-squared = 6.6%. Again, we’ll discuss interaction more substantially in 432.
17.12 Predictions from these Linear Models
What is our predicted SBP for a subject weighing 175 pounds?
How does that change if our subject weighs 200 pounds?
Recall that
- Without Arcus Senilis, linear model for SBP = 95.9 + 0.19 x weight
- With Arcus Senilis, linear model for SBP = 101.9 + 0.16 x weight
So the predictions for a 175 pound subject are:
95.9 + 0.19 x 175 = 129 mm Hg without Arcus Senilis, and
101.9 + 0.16 x 175 = 130 mm Hg with Arcus Senilis.
And thus, the predictions for a 200 pound subject are:
95.9 + 0.19 x 200 = 134 mm Hg without Arcus Senilis, and
101.9 + 0.16 x 200 = 134.4 mm Hg with Arcus Senilis.
17.13 Scatterplots with Facets Across a Categorical Variable
We can use facets in ggplot2
to show scatterplots across the levels of a categorical variable, like behpat
.
ggplot(wcgs, aes(x = weight, y = sbp, col = behpat)) +
geom_point() +
facet_wrap(~ behpat) +
geom_smooth(method = "lm", se = FALSE,
formula = y ~ x, col = "black") +
guides(color = "none") +
theme(strip.text = element_text(face="bold", size=rel(1.25), color="white"),
strip.background = element_rect(fill="royalblue")) +
labs(title = "Scatterplots of SBP vs. Weight within Behavior Pattern")
17.14 Scatterplot and Correlation Matrices
A scatterplot matrix can be very helpful in understanding relationships between multiple variables simultaneously. There are several ways to build such a thing, including the pairs
function…
pairs (~ sbp + age + weight + height, data=wcgs,
main="Simple Scatterplot Matrix")
17.14.1 Displaying a Correlation Matrix
wcgs |>
select(sbp, age, weight, height) |>
cor() |>
kbl(digits = 3) |>
kable_styling(full_width = FALSE)
sbp | age | weight | height | |
---|---|---|---|---|
sbp | 1.000 | 0.166 | 0.253 | 0.018 |
age | 0.166 | 1.000 | -0.034 | -0.095 |
weight | 0.253 | -0.034 | 1.000 | 0.533 |
height | 0.018 | -0.095 | 0.533 | 1.000 |
17.14.2 Using the GGally
package
The ggplot2
system doesn’t have a built-in scatterplot system. There are some nice add-ins in the world, though. One option I sort of like is in the GGally
package, which can produce both correlation matrices and scatterplot matrices.
The ggpairs
function provides a density plot on each diagonal, Pearson correlations on the upper right and scatterplots on the lower left of the matrix.
For more on the WCGS, you might look at http://www.epi.umn.edu/cvdepi/study-synopsis/western-collaborative-group-study/↩︎