How to manually calculate structure coefficients for part R2? - r

Question

Libraries, Data, and LMER Model
I am using these three libraries for this inquiry:
#### Libraries ####
library(lmerTest)
library(performance)
library(partR2)
I have built a lmer model using this data:
structure(list(Mins_Work = c(435L, 350L, 145L, 135L, 15L, 60L,
60L, 390L, 395L, 395L, 315L, 80L, 580L, 175L, 545L, 230L, 435L,
370L, 255L, 515L, 330L, 65L, 115L, 550L, 420L, 45L, 266L, 196L,
198L, 220L, 17L, 382L, 0L, 180L, 343L, 207L, 263L, 332L, 0L,
0L, 259L, 417L, 282L, 685L, 517L, 111L, 64L, 466L, 499L, 460L,
269L, 300L, 427L, 301L, 436L, 342L, 229L, 379L, 102L, 146L, 94L,
345L, 73L, 204L, 512L, 113L, 135L, 458L, 493L, 552L, 108L, 335L,
395L, 508L, 546L, 396L, 159L, 325L, 747L, 650L, 377L, 461L, 669L,
186L, 220L, 410L, 708L, 409L, 515L, 413L, 166L, 451L, 660L, 177L,
192L, 191L, 461L, 637L, 297L, 601L, 586L, 270L, 479L, 0L, 480L,
397L, 174L, 111L, 0L, 610L, 332L, 345L, 423L, 160L, 611L, 0L,
345L, 550L, 324L, 427L, 505L, 632L, 560L, 230L, 495L, 235L, 522L,
654L, 465L, 377L, 260L, 572L, 612L, 594L, 624L, 237L, 0L, 38L,
409L, 634L, 292L, 706L, 399L, 568L, 0L, 694L, 298L, 616L, 553L,
581L, 423L, 636L, 623L, 338L, 345L, 521L, 438L, 504L, 600L, 616L,
656L, 285L, 474L, 688L, 278L, 383L, 535L, 363L, 470L, 457L, 303L,
123L, 363L, 329L, 513L, 636L, 421L, 220L, 430L, 428L, 536L, 156L,
615L, 429L, 103L, 332L, 250L, 281L, 248L, 435L, 589L, 515L, 158L,
0L, 649L, 427L, 193L, 225L, 0L, 280L, 163L, 536L, 301L, 406L,
230L, 519L, 0L, 303L, 472L, 392L, 326L, 368L, 405L, 515L, 308L,
259L, 769L, 93L, 517L, 261L, 420L, 248L, 265L, 834L, 313L, 131L,
298L, 134L, 385L, 648L, 529L, 487L, 533L, 641L, 429L, 339L, 508L,
560L, 439L, 381L, 397L, 692L, 534L, 148L, 366L, 167L, 425L, 476L,
384L, 498L, 502L, 308L, 360L, 203L, 410L, 626L, 593L, 409L, 531L,
157L, 0L, 357L, 443L, 615L, 564L, 341L, 352L, 609L, 686L, 386L,
323L, 362L, 597L, 325L, 51L, 570L, 579L, 284L, 0L), Coffee_Cups = c(3L,
0L, 2L, 6L, 4L, 5L, 3L, 3L, 2L, 2L, 3L, 1L, 1L, 3L, 2L, 2L, 0L,
1L, 1L, 4L, 4L, 3L, 0L, 1L, 3L, 0L, 0L, 0L, 0L, 2L, 0L, 1L, 2L,
3L, 2L, 2L, 4L, 3L, 6L, 6L, 3L, 4L, 6L, 8L, 3L, 5L, 0L, 2L, 2L,
8L, 6L, 4L, 6L, 4L, 4L, 2L, 6L, 6L, 5L, 1L, 1L, 5L, 4L, 6L, 5L,
0L, 6L, 6L, 4L, 4L, 2L, 2L, 6L, 6L, 7L, 3L, 3L, 0L, 5L, 7L, 6L,
3L, 5L, 3L, 3L, 1L, 9L, 9L, 3L, 3L, 6L, 6L, 6L, 3L, 0L, 7L, 6L,
6L, 3L, 9L, 3L, 8L, 8L, 3L, 3L, 7L, 6L, 3L, 3L, 3L, 6L, 6L, 6L,
1L, 9L, 3L, 3L, 2L, 6L, 3L, 6L, 9L, 6L, 8L, 9L, 6L, 6L, 6L, 0L,
3L, 0L, 3L, 3L, 6L, 3L, 0L, 9L, 3L, 0L, 2L, 0L, 6L, 6L, 6L, 3L,
6L, 3L, 9L, 3L, 0L, 0L, 6L, 3L, 3L, 3L, 3L, 6L, 0L, 6L, 3L, 3L,
5L, 5L, 3L, 0L, 6L, 4L, 2L, 0L, 2L, 4L, 0L, 6L, 4L, 4L, 2L, 2L,
0L, 9L, 6L, 3L, 6L, 6L, 9L, 0L, 6L, 6L, 6L, 6L, 6L, 6L, 3L, 3L,
0L, 9L, 6L, 3L, 6L, 3L, 6L, 1L, 6L, 6L, 6L, 6L, 6L, 1L, 3L, 9L,
6L, 3L, 6L, 9L, 3L, 5L, 6L, 3L, 0L, 6L, 3L, 3L, 5L, 0L, 6L, 3L,
5L, 3L, 0L, 6L, 7L, 3L, 6L, 6L, 6L, 6L, 3L, 5L, 6L, 7L, 6L, 6L,
4L, 6L, 4L, 5L, 5L, 6L, 8L, 6L, 6L, 6L, 9L, 3L, 3L, 9L, 7L, 8L,
4L, 3L, 3L, 3L, 6L, 6L, 6L, 3L, 4L, 3L, 3L, 6L, 4L, 3L, 3L, 4L,
6L, 0L, 3L, 6L, 4L, 3L), Tea_Cups = c(2L, 4L, 2L, 0L, 0L, 2L,
0L, 2L, 4L, 0L, 0L, 0L, 2L, 6L, 5L, 0L, 2L, 0L, 2L, 4L, 0L, 0L,
0L, 2L, 1L, 0L, 4L, 4L, 4L, 2L, 1L, 0L, 2L, 0L, 0L, 4L, 2L, 0L,
0L, 0L, 0L, 0L, 0L, 0L, 2L, 0L, 1L, 0L, 2L, 0L, 0L, 2L, 0L, 3L,
0L, 2L, 0L, 2L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 2L, 0L, 0L,
0L, 0L, 0L, 1L, 0L, 0L, 0L, 2L, 0L, 0L, 2L, 0L, 0L, 0L, 0L, 0L,
0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
0L, 0L, 0L, 0L, 3L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
6L, 3L, 0L, 3L, 3L, 0L, 0L, 0L, 6L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
0L, 0L, 0L, 0L, 0L, 2L, 0L, 0L, 0L, 3L, 0L, 0L, 0L, 0L, 0L, 0L,
0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
3L, 0L, 0L, 0L, 3L, 0L, 0L, 6L, 0L, 0L, 0L, 0L, 3L, 0L, 6L, 0L,
0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 3L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
0L, 3L, 5L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 3L,
0L, 0L, 0L, 0L, 0L, 0L, 0L, 2L, 0L, 0L, 0L, 0L, 0L, 0L, 3L, 0L,
0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 3L, 0L, 0L, 0L,
0L, 0L, 3L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 3L, 1L, 0L, 0L, 0L, 0L, 0L,
0L)), class = "data.frame", row.names = c(NA, -279L))
This is the model itself:
model.work <- lmer(Mins_Work ~ Coffee_Cups + Tea_Cups +
(1|Month_Name),
data = work)
Solution So Far
Based off the instructions here for the partR2 package, I have calculated beta weights, inclusive R2, and part R2. First, by automatically calculating it with this code:
#### Obtain Part R2 ####
part.work <- partR2(model.work,
partvars = c("Coffee_Cups",
"Tea_Cups"),
data = work,
nboot = 100)
summary(part.work)
I obtain the numbers for each:
R2 (marginal) and 95% CI for the full model:
R2 CI_lower CI_upper ndf
0.105 0.0557 0.1771 3
----------
Part (semi-partial) R2:
Predictor(s) R2 CI_lower CI_upper ndf
Model 0.1050 0.0557 0.1771 3
Coffee_Cups 0.1011 0.0518 0.1734 2
Tea_Cups 0.0015 0.0000 0.0773 2
Coffee_Cups+Tea_Cups 0.1050 0.0557 0.1771 1
----------
Inclusive R2 (SC^2 * R2):
Predictor IR2 CI_lower CI_upper
Coffee_Cups 0.0999 0.0491 0.1707
Tea_Cups 0.0012 0.0000 0.0171
----------
Structure coefficients r(Yhat,x):
Predictor SC CI_lower CI_upper
Coffee_Cups 0.9753 0.8541 0.9993
Tea_Cups 0.1077 -0.2130 0.4190
----------
Beta weights (standardised estimates)
Predictor BW CI_lower CI_upper
Coffee_Cups 0.3262 0.2362 0.4283
Tea_Cups 0.0724 -0.0322 0.1700
----------
I have manually obtained all these measures with the following code:
#### Manually Calculate Pseudo R Square ####
var.ran <- get_variance_random(model.work, verbose = TRUE)
var.fix <- get_variance_fixed(model.work, verbose = TRUE)
var.res <- get_variance_residual(model.work, verbose = TRUE)
var.ran # random effect variance
var.res # residual variance
var.fix # fixed effect variance
mar.r.square <- (var.fix/(var.fix+var.ran+var.res))
con.r.square <- ((var.fix+var.ran)/(var.fix+var.ran+var.res))
mar.r.square # effect of fixed factors
con.r.square # effect of fixed and random
mar.r.square-con.r.square # # effect of random
#### Manually Calculate Part R2 ####
reduced <- lmer(Mins_Work ~ Tea_Cups +
(1|Month_Name),
data = work)
reduced.fix <- get_variance_fixed(reduced)
(var.fix-reduced.fix)/(var.fix+var.ran+var.res) # coffee part R2
#### Manually Calculate Beta Weights ####
25.45*sd(work$Coffee_Cups)/sd(work$Mins_Work) # coffee predictor
10.39*sd(work$Tea_Cups)/sd(work$Mins_Work) # tea predictor
#### Manually Calculate Inclusive R2 ####
.9753^2*.105 # coffee predictor
.1077^2*.105 # tea predictor
Problem
The single value I am still having issues with obtaining is the structure coefficient for each predictor. This is supposedly obtained by measuring the correlation between predicted y and a single predictor x. I tried doing this with the following code:
cor(predict(model.work),work$Coffee_Cups)
Which gives me this value:
1] 0.8222992
This however doesn't match the value in the summarized output from the partR2 function:
Structure coefficients r(Yhat,x):
Predictor SC CI_lower CI_upper
Coffee_Cups 0.9753 0.8541 0.9993
What am I missing here? Am I reading something wrong?