R Notebook
summary_df <- data.frame(
Material = c(
rep("Polyfoam", 15), rep("Memory foam", 15), rep("Latex", 15),
rep("Polyfoam", 15), rep("Memory foam", 15), rep("Latex", 15)
),
Session = c(
rep(1, 45),
rep(2, 45)
),
Trial = rep(rep(1:5, each = 3), 6),
Location = rep(c("Low","Mid","High"), 30),
Score = c(
# Session 1
7,5,4, 7,6,3, 8,5,3, 7,4,2, 6,4,2,
7,4,3, 7,5,3, 6,5,3, 7,3,2, 7,3,2,
5,4,2, 5,4,2, 6,3,2, 5,3,1, 4,3,2,
# Session 2
7,5,5, 6,5,4, 6,4,3, 7,4,3, 6,3,2,
8,6,5, 9,7,4, 8,7,4, 7,5,3, 7,6,3,
6,5,3, 5,5,3, 6,4,3, 5,4,2, 5,4,3
)
)anatomical_df <- data.frame(
Material = c(
rep("Control", 45),
rep("Polyfoam", 45),
rep("Memory foam", 45),
rep("Latex", 45)
),
Placement = rep(rep(c("L1-L5", "T1-T6", "T7-T12"), each = 15), 4),
Photograph = rep(rep(1:5, each = 3), 12),
Measurement = rep(rep(1:3, times = 5), 12),
Spinal_Angle = c(
# CONTROL
13.278,13.714,14.043, 13.618,13.266,13.885, 14.008,14.05,13.806,
13.148,13.309,12.996, 13.164,13.007,12.98,
12.441,12.352,12.87, 12.002,12.51,12.216, 12.493,11.784,11.829,
11.999,11.975,12.93, 12.568,11.894,11.842,
11.699,11.56,11.604, 10.789,10.856,10.309, 10.588,10.457,10.894,
10.998,10.972,11.493, 11.409,10.855,10.793,
# POLYFOAM (L1-L5 only shown start; continues below)
17.878,17.588,18.013, 17.641,17.599,17.56, 17.392,17.485,17.422,
17.912,17.312,17.588, 17.381,17.246,17.482,
23.497,23.213,23.032, 23.962,23.172,23.363, 23.92,23.876,23.001,
23.052,23.983,23.871, 23.138,23.137,23.281,
23.4,23.209,23.332, 23.891,23.567,23.856, 22.991,23.312,23.429,
23.679,23.004,23.455, 23.18,23.754,23.62,
# MEMORY FOAM
15.817,16.048,16.003, 16.92,16.819,16.521, 15.459,15.541,16.291,
17.101,16.723,16.876, 16.58,16.014,15.705,
16.867,16.559,16.956, 15.856,16.303,15.549, 17.29,17.11,16.687,
16.582,16.722,16.659, 17.137,15.998,16.902,
28.204,29.026,28.828, 29.116,28.593,28.476, 28.772,28.795,28.901,
29.104,28.403,28.688, 28.429,29.07,29.215,
# LATEX
14.255,14.603,14.144, 14.272,14.233,14.162, 14.257,14.159,13.99,
14.801,14.436,14.334, 14.265,14.138,14.251,
18.3,18.314,18.879, 18.483,18.106,18.342, 18.496,18.399,18.205,
18.448,18.319,18.44, 18.365,18.338,18.413,
39.951,40.661,41.975, 40.452,40.061,40.646, 40.573,40.795,41.388,
40.27,40.784,40.919, 40.031,40.201,40.548
),
Pelvic_Angle = c(
# CONTROL
11.936,11.146,11.752, 11.381,11.342,11.436, 11.895,11.769,12.004,
11.248,11.55,11.086, 11.92,11.785,11.432,
11.571,11.528,11.93, 11.398,11.828,11.617, 11.896,11.041,11.22,
11.461,11.415,12.01, 11.725,11.314,11.289,
12.088,11.864,11.932, 11.44,11.523,10.997, 11.391,11.232,11.547,
11.661,11.585,11.815, 11.766,11.414,11.353,
# POLYFOAM
5.891,5.711,6.451, 5.795,5.762,5.75, 5.568,5.697,5.673,
6.442,5.484,5.729, 5.548,5.467,5.692,
40.732,40.299,40.101, 41.003,40.22,40.368, 40.992,40.978,40.027,
40.113,41.01,40.983, 40.191,40.191,40.319,
27.303,27.102,27.221, 27.694,27.419,27.605, 26.735,27.212,27.32,
28.572,26.972,27.403, 27.066,28.614,28.501,
# MEMORY FOAM
7.125,8.833,8.241, 8.383,8.415,8.279, 7.034,7.29,8.104,
8.952,8.55,8.571, 8.321,8.259,6.992,
38.863,37.823,37.36, 37.528,37.649,36.992, 38.97,38.784,37.95,
37.621,37.844,37.825, 38.106,37.601,38.438,
26.102,27.904,26.953, 27.815,27.02,27.61, 27.745,27.891,27.917,
28.089,26.334,26.782, 27.486,28.141,28.198,
# LATEX
9.748,9.814,9.692, 9.748,9.732,9.711, 9.725,9.704,9.473,
10.08,9.801,9.795, 9.744,9.698,9.738,
38.508,38.594,39.062, 38.686,38.105,38.443, 38.699,38.598,38.27,
38.669,38.58,38.652, 38.594,38.431,38.601,
27.553,28.201,28.509, 28.064,27.932,28.178, 28.106,28.294,28.407,
28.008,28.292,28.387, 27.905,27.991,28.09
)
)library(ggplot2)
ggplot(summary_df, aes(x = Location, y = Score, fill = Material)) +
geom_boxplot() +
facet_wrap(~Session) +
theme_classic() +
labs(title = "Effect of Lumbar Support Location on Score",
y = "Score", x = "Support Location")
library(dplyr)
library(ggplot2)
means <- summary_df %>%
group_by(Material, Location, Session) %>%
summarize(mean_score = mean(Score), .groups = "drop")
ggplot(means,
aes(x = Location,
y = mean_score,
color = Session,
group = Session)) +
geom_line(size = 1.2, position = position_dodge(0.2)) +
geom_point(size = 3, position = position_dodge(0.2)) +
facet_wrap(~Material) +
theme_classic() +
labs(title = "Pre vs Post Comparison Across Lumbar Support Locations",
y = "Mean Score",
x = "Support Location")library(dplyr)
summary_df$Session <- factor(summary_df$Session,
levels = c(1, 2),
labels = c("Pre", "Post"))
summary_df$Location <- factor(summary_df$Location,
levels = c("Low", "Mid", "High"))
summary_df$Material <- factor(summary_df$Material)
ggplot(summary_df,
aes(x = Session,
y = Score,
color = Location)) +
# Raw data (jittered)
geom_jitter(position = position_jitterdodge(jitter.width = 0.1,
dodge.width = 0.6),
alpha = 0.5) +
# Mean points
stat_summary(fun = mean,
geom = "point",
size = 3,
position = position_dodge(width = 0.6)) +
# Mean lines (THIS is the key part)
stat_summary(fun = mean,
geom = "line",
aes(group = Location), # connects Pre → Post
linewidth = 1.2,
position = position_dodge(width = 0.6)) +
facet_wrap(~Material) +
theme_classic() +
labs(title = "Pre vs Post Changes by Material and Location",
y = "Score")library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionsummary_angles <- anatomical_df %>%
group_by(Material, Placement) %>%
summarize(
mean_spinal = mean(Spinal_Angle),
mean_pelvic = mean(Pelvic_Angle),
.groups = "drop"
)
summary_anglescontrol_means <- summary_angles %>%
filter(Material == "Control") %>%
dplyr::select(Placement, control_spinal = mean_spinal)
summary_diff <- summary_angles %>%
left_join(control_means, by = "Placement") %>%
mutate(delta_spinal = round(mean_spinal - control_spinal, 2))
summary_difflibrary(lme4)## Loading required package: Matrixmodel_spine <- lmer(
Spinal_Angle ~ Material * Placement + (1|Photograph),
data = anatomical_df
)
summary(model_spine)## Linear mixed model fit by REML ['lmerMod']
## Formula: Spinal_Angle ~ Material * Placement + (1 | Photograph)
## Data: anatomical_df
##
## REML criterion at convergence: 185.1
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.7557 -0.6459 -0.0496 0.6934 3.4611
##
## Random effects:
## Groups Name Variance Std.Dev.
## Photograph (Intercept) 0.003932 0.0627
## Residual 0.142859 0.3780
## Number of obs: 180, groups: Photograph, 5
##
## Fixed effects:
## Estimate Std. Error t value
## (Intercept) 13.4848 0.1015 132.803
## MaterialLatex 0.8019 0.1380 5.810
## MaterialMemory foam 2.8097 0.1380 20.358
## MaterialPolyfoam 4.0818 0.1380 29.575
## PlacementT1-T6 -1.2378 0.1380 -8.969
## PlacementT7-T12 -2.4664 0.1380 -17.871
## MaterialLatex:PlacementT1-T6 5.3409 0.1952 27.364
## MaterialMemory foam:PlacementT1-T6 1.5551 0.1952 7.967
## MaterialPolyfoam:PlacementT1-T6 7.1044 0.1952 36.399
## MaterialLatex:PlacementT7-T12 28.7967 0.1952 147.538
## MaterialMemory foam:PlacementT7-T12 14.9465 0.1952 76.578
## MaterialPolyfoam:PlacementT7-T12 8.3451 0.1952 42.755
##
## Correlation of Fixed Effects:
## (Intr) MtrlLt MtrlMf MtrlPl PT1-T6 PT7-T1 ML:PT1 MMf:PT1 MP:PT1
## MaterialLtx -0.680
## MatrlMmryfm -0.680 0.500
## MaterlPlyfm -0.680 0.500 0.500
## PlcmntT1-T6 -0.680 0.500 0.500 0.500
## PlcmnT7-T12 -0.680 0.500 0.500 0.500 0.500
## MtrL:PT1-T6 0.481 -0.707 -0.354 -0.354 -0.707 -0.354
## MtMf:PT1-T6 0.481 -0.354 -0.707 -0.354 -0.707 -0.354 0.500
## MtrP:PT1-T6 0.481 -0.354 -0.354 -0.707 -0.707 -0.354 0.500 0.500
## MtL:PT7-T12 0.481 -0.707 -0.354 -0.354 -0.354 -0.707 0.500 0.250 0.250
## MMf:PT7-T12 0.481 -0.354 -0.707 -0.354 -0.354 -0.707 0.250 0.500 0.250
## MtP:PT7-T12 0.481 -0.354 -0.354 -0.707 -0.354 -0.707 0.250 0.250 0.500
## ML:PT7 MMf:PT7
## MaterialLtx
## MatrlMmryfm
## MaterlPlyfm
## PlcmntT1-T6
## PlcmnT7-T12
## MtrL:PT1-T6
## MtMf:PT1-T6
## MtrP:PT1-T6
## MtL:PT7-T12
## MMf:PT7-T12 0.500
## MtP:PT7-T12 0.500 0.500Spinal angle depends both on the material and the location on the spine, and their interaction. The effect of pillow material is not the same across spinal regions.
Random effects: Photograph variance = very small (0.0039) Residual variance = 0.14
Interpretation: Measurements are very consistent across photos Good—your system is stable and reproducible
(Intercept) = 13.48
This represents:Control material, L1–L5 (lumbar region)
So:Baseline spinal angle ≈ 13.5° Latex: +0.8° Memory foam: +2.8° Polyfoam: +4.1°
At the lumbar region, all materials increase curvature, with polyfoam having the strongest effect
Compared to L1–L5:
T1–T6: −1.24° T7–T12: −2.47°
Interpretation: Without support, curvature naturally decreases up the spine
At T1–T6:
Add these to the baseline effects:
Latex: +5.34° Memory foam: +4.56° Polyfoam: +7.10°
Meaning: Materials start to behave differently in the upper thoracic region ___ At T7–T12 (THIS IS HUGE) Latex: +28.8° (!!) Memory foam: +14.9° Polyfoam: +8.35°
Meaning: Latex causes a massive increase in curvature in the lower thoracic region
Conclusions:
- Materials do not act uniformly along the spine. Strong location-specific effects
- Latex behaves very differently from other materials. Minimal effect at lumbar, extreme effect at T7-T12. It redistributes curvature rather than uniformly supporting the spine.
- Polyfoam is more consistent. Moderate increases across regions with less extreme shifts. ___
Pelvic Conclusions
library(lme4)
library(lmerTest)##
## Attaching package: 'lmerTest'## The following object is masked from 'package:lme4':
##
## lmer## The following object is masked from 'package:stats':
##
## steplibrary(emmeans)## Welcome to emmeans.
## Caution: You lose important information if you filter this package's results.
## See '? untidy'# fit the model
model_pelvis <- lmer(
Pelvic_Angle ~ Material * Placement + (1 | Photograph),
data = anatomical_df
)## boundary (singular) fit: see help('isSingular')# full model summary
summary(model_pelvis)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: Pelvic_Angle ~ Material * Placement + (1 | Photograph)
## Data: anatomical_df
##
## REML criterion at convergence: 221.9
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.2071 -0.5205 -0.0433 0.5493 2.5822
##
## Random effects:
## Groups Name Variance Std.Dev.
## Photograph (Intercept) 0.0000 0.0000
## Residual 0.1808 0.4252
## Number of obs: 180, groups: Photograph, 5
##
## Fixed effects:
## Estimate Std. Error df t value
## (Intercept) 11.578800 0.109798 168.000000 105.456
## MaterialLatex -1.831933 0.155277 168.000000 -11.798
## MaterialMemory foam -3.488867 0.155277 168.000000 -22.469
## MaterialPolyfoam -5.801467 0.155277 168.000000 -37.362
## PlacementT1-T6 -0.029267 0.155277 168.000000 -0.188
## PlacementT7-T12 -0.004933 0.155277 168.000000 -0.032
## MaterialLatex:PlacementT1-T6 28.848533 0.219595 168.000000 131.372
## MaterialMemory foam:PlacementT1-T6 29.896267 0.219595 168.000000 136.143
## MaterialPolyfoam:PlacementT1-T6 34.753733 0.219595 168.000000 158.263
## MaterialLatex:PlacementT7-T12 18.385867 0.219595 168.000000 83.726
## MaterialMemory foam:PlacementT7-T12 19.380800 0.219595 168.000000 88.257
## MaterialPolyfoam:PlacementT7-T12 21.743533 0.219595 168.000000 99.017
## Pr(>|t|)
## (Intercept) <2e-16 ***
## MaterialLatex <2e-16 ***
## MaterialMemory foam <2e-16 ***
## MaterialPolyfoam <2e-16 ***
## PlacementT1-T6 0.851
## PlacementT7-T12 0.975
## MaterialLatex:PlacementT1-T6 <2e-16 ***
## MaterialMemory foam:PlacementT1-T6 <2e-16 ***
## MaterialPolyfoam:PlacementT1-T6 <2e-16 ***
## MaterialLatex:PlacementT7-T12 <2e-16 ***
## MaterialMemory foam:PlacementT7-T12 <2e-16 ***
## MaterialPolyfoam:PlacementT7-T12 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) MtrlLt MtrlMf MtrlPl PT1-T6 PT7-T1 ML:PT1 MMf:PT1 MP:PT1
## MaterialLtx -0.707
## MatrlMmryfm -0.707 0.500
## MaterlPlyfm -0.707 0.500 0.500
## PlcmntT1-T6 -0.707 0.500 0.500 0.500
## PlcmnT7-T12 -0.707 0.500 0.500 0.500 0.500
## MtrL:PT1-T6 0.500 -0.707 -0.354 -0.354 -0.707 -0.354
## MtMf:PT1-T6 0.500 -0.354 -0.707 -0.354 -0.707 -0.354 0.500
## MtrP:PT1-T6 0.500 -0.354 -0.354 -0.707 -0.707 -0.354 0.500 0.500
## MtL:PT7-T12 0.500 -0.707 -0.354 -0.354 -0.354 -0.707 0.500 0.250 0.250
## MMf:PT7-T12 0.500 -0.354 -0.707 -0.354 -0.354 -0.707 0.250 0.500 0.250
## MtP:PT7-T12 0.500 -0.354 -0.354 -0.707 -0.354 -0.707 0.250 0.250 0.500
## ML:PT7 MMf:PT7
## MaterialLtx
## MatrlMmryfm
## MaterlPlyfm
## PlcmntT1-T6
## PlcmnT7-T12
## MtrL:PT1-T6
## MtMf:PT1-T6
## MtrP:PT1-T6
## MtL:PT7-T12
## MMf:PT7-T12 0.500
## MtP:PT7-T12 0.500 0.500
## optimizer (nloptwrap) convergence code: 0 (OK)
## boundary (singular) fit: see help('isSingular')# ANOVA table for main effects and interaction
anova(model_pelvis)# estimated marginal means
emm_pelvis <- emmeans(model_pelvis, ~ Material * Placement)## Cannot use mode = "kenward-roger" because *pbkrtest* package is not installedsummary(emm_pelvis)# pairwise comparisons of materials within each region
emmeans(model_pelvis, pairwise ~ Material | Placement, adjust = "tukey")## Cannot use mode = "kenward-roger" because *pbkrtest* package is not installed## $emmeans
## Placement = L1-L5:
## Material emmean SE df lower.CL upper.CL
## Control 11.58 0.11 168 11.36 11.80
## Latex 9.75 0.11 168 9.53 9.96
## Memory foam 8.09 0.11 168 7.87 8.31
## Polyfoam 5.78 0.11 168 5.56 5.99
##
## Placement = T1-T6:
## Material emmean SE df lower.CL upper.CL
## Control 11.55 0.11 168 11.33 11.77
## Latex 38.57 0.11 168 38.35 38.78
## Memory foam 37.96 0.11 168 37.74 38.17
## Polyfoam 40.50 0.11 168 40.29 40.72
##
## Placement = T7-T12:
## Material emmean SE df lower.CL upper.CL
## Control 11.57 0.11 168 11.36 11.79
## Latex 28.13 0.11 168 27.91 28.34
## Memory foam 27.47 0.11 168 27.25 27.68
## Polyfoam 27.52 0.11 168 27.30 27.73
##
## Degrees-of-freedom method: satterthwaite
## Confidence level used: 0.95
##
## $contrasts
## Placement = L1-L5:
## contrast estimate SE df t.ratio p.value
## Control - Latex 1.8319 0.155 168 11.798 <0.0001
## Control - Memory foam 3.4889 0.155 168 22.469 <0.0001
## Control - Polyfoam 5.8015 0.155 168 37.362 <0.0001
## Latex - Memory foam 1.6569 0.155 168 10.671 <0.0001
## Latex - Polyfoam 3.9695 0.155 168 25.564 <0.0001
## Memory foam - Polyfoam 2.3126 0.155 168 14.893 <0.0001
##
## Placement = T1-T6:
## contrast estimate SE df t.ratio p.value
## Control - Latex -27.0166 0.155 168 -173.990 <0.0001
## Control - Memory foam -26.4074 0.155 168 -170.066 <0.0001
## Control - Polyfoam -28.9523 0.155 168 -186.455 <0.0001
## Latex - Memory foam 0.6092 0.155 168 3.923 0.0007
## Latex - Polyfoam -1.9357 0.155 168 -12.466 <0.0001
## Memory foam - Polyfoam -2.5449 0.155 168 -16.389 <0.0001
##
## Placement = T7-T12:
## contrast estimate SE df t.ratio p.value
## Control - Latex -16.5539 0.155 168 -106.609 <0.0001
## Control - Memory foam -15.8919 0.155 168 -102.346 <0.0001
## Control - Polyfoam -15.9421 0.155 168 -102.668 <0.0001
## Latex - Memory foam 0.6620 0.155 168 4.263 0.0002
## Latex - Polyfoam 0.6119 0.155 168 3.940 0.0007
## Memory foam - Polyfoam -0.0501 0.155 168 -0.323 0.9883
##
## Degrees-of-freedom method: satterthwaite
## P value adjustment: tukey method for comparing a family of 4 estimates# pairwise comparisons of regions within each material
emmeans(model_pelvis, pairwise ~ Placement | Material, adjust = "tukey")## Cannot use mode = "kenward-roger" because *pbkrtest* package is not installed## $emmeans
## Material = Control:
## Placement emmean SE df lower.CL upper.CL
## L1-L5 11.58 0.11 168 11.36 11.80
## T1-T6 11.55 0.11 168 11.33 11.77
## T7-T12 11.57 0.11 168 11.36 11.79
##
## Material = Latex:
## Placement emmean SE df lower.CL upper.CL
## L1-L5 9.75 0.11 168 9.53 9.96
## T1-T6 38.57 0.11 168 38.35 38.78
## T7-T12 28.13 0.11 168 27.91 28.34
##
## Material = Memory foam:
## Placement emmean SE df lower.CL upper.CL
## L1-L5 8.09 0.11 168 7.87 8.31
## T1-T6 37.96 0.11 168 37.74 38.17
## T7-T12 27.47 0.11 168 27.25 27.68
##
## Material = Polyfoam:
## Placement emmean SE df lower.CL upper.CL
## L1-L5 5.78 0.11 168 5.56 5.99
## T1-T6 40.50 0.11 168 40.29 40.72
## T7-T12 27.52 0.11 168 27.30 27.73
##
## Degrees-of-freedom method: satterthwaite
## Confidence level used: 0.95
##
## $contrasts
## Material = Control:
## contrast estimate SE df t.ratio p.value
## (L1-L5) - (T1-T6) 0.02927 0.155 168 0.188 0.9806
## (L1-L5) - (T7-T12) 0.00493 0.155 168 0.032 0.9994
## (T1-T6) - (T7-T12) -0.02433 0.155 168 -0.157 0.9866
##
## Material = Latex:
## contrast estimate SE df t.ratio p.value
## (L1-L5) - (T1-T6) -28.81927 0.155 168 -185.599 <0.0001
## (L1-L5) - (T7-T12) -18.38093 0.155 168 -118.375 <0.0001
## (T1-T6) - (T7-T12) 10.43833 0.155 168 67.224 <0.0001
##
## Material = Memory foam:
## contrast estimate SE df t.ratio p.value
## (L1-L5) - (T1-T6) -29.86700 0.155 168 -192.346 <0.0001
## (L1-L5) - (T7-T12) -19.37587 0.155 168 -124.782 <0.0001
## (T1-T6) - (T7-T12) 10.49113 0.155 168 67.564 <0.0001
##
## Material = Polyfoam:
## contrast estimate SE df t.ratio p.value
## (L1-L5) - (T1-T6) -34.72447 0.155 168 -223.629 <0.0001
## (L1-L5) - (T7-T12) -21.73860 0.155 168 -139.999 <0.0001
## (T1-T6) - (T7-T12) 12.98587 0.155 168 83.630 <0.0001
##
## Degrees-of-freedom method: satterthwaite
## P value adjustment: tukey method for comparing a family of 3 estimates# confidence intervals for estimated means
confint(emm_pelvis)# optional: inspect random effects variance clearly
VarCorr(model_pelvis)## Groups Name Std.Dev.
## Photograph (Intercept) 0.00000
## Residual 0.42524Pelvic angle depends on both material and spinal region, with a meaningful interaction between the two.The effect of lumbar support materials on pelvic positioning is region-dependent, not uniform.
Photograph variance = 0.0000 Residual variance = 0.1808
Interpretation: There is no measurable variation across photographs. Measurements are extremely consistent. The system is highly stable and reproducible
(Intercept) = 11.58
This represents: Control material. L1–L5 (lumbar region)
So: Baseline pelvic angle ≈ 11.6°
Material effects at L1–L5
Compared to control:
Latex: −1.83° Memory foam: −3.49° Polyfoam: −5.80°
Interpretation: At the lumbar region, all materials decrease pelvic angle, with polyfoam producing the largest reduction ___
Placement effects (control condition)
Compared to L1–L5:
T1–T6: −0.03° T7–T12: −0.005°
Interpretation: In the absence of support, pelvic angle is essentially unchanged across regions..
This is a BIG difference from the spine.
At T1–T6 Latex: +28.85° Memory foam: +29.90° Polyfoam: +34.75°
Meaning: All materials cause a very large increase in pelvic angle in the upper thoracic region
At T7–T12 Latex: +18.39° Memory foam: +19.38° Polyfoam: +21.74°
Meaning: Materials also increase pelvic angle substantially in the lower thoracic region, but less than at T1–T6 ___
- Pelvic angle is stable without support
Unlike spinal curvature, pelvic angle shows no natural regional variation in the control condition
- Materials strongly influence pelvic positioning—but only away from the lumbar region
At L1–L5 → small decreases At T1–T6 and T7–T12 → very large increases
This suggests: The pelvis is not directly responding locally, but rather responding to changes elsewhere in the spine
- All materials produce similar directional effects
Unlike spinal curvature (where latex behaved uniquely), all materials increase pelvic angle in thoracic regions
- Polyfoam produces the strongest overall shifts
Especially at T1–T6, where it produces the largest increase
While lumbar support materials produce region-specific effects on spinal curvature, their influence on pelvic angle is more uniform and indirect, reflecting a coordinated biomechanical response across the axial skeleton.
Together, these results suggest that lumbar supports act locally on spinal curvature but induce global compensatory changes in pelvic alignment.
library(emmeans)
library(ggplot2)
emm_df <- as.data.frame(confint(emmeans(model_spine, ~ Material * Placement)))## Cannot use mode = "kenward-roger" because *pbkrtest* package is not installedemm_df$Placement <- factor(emm_df$Placement,
levels = c("L1-L5", "T1-T6", "T7-T12"))
emm_df$Material <- factor(emm_df$Material,
levels = c("Control", "Latex", "Memory foam", "Polyfoam"))
ggplot(emm_df, aes(x = Material, y = emmean, color = Material, group = 1)) +
geom_errorbar(aes(ymin = lower.CL, ymax = upper.CL),
width = 0.18, linewidth = 1.1) +
geom_line(linewidth = 0.9, color = "gray35") +
geom_point(size = 4) +
facet_wrap(~Placement, nrow = 1) +
theme_classic(base_size = 13) +
labs(title = "Effect of Material on Spinal Angle by Region",
x = "Material",
y = "Estimated Spinal Angle (°)") +
theme(
strip.background = element_rect(fill = "white", color = "black"),
strip.text = element_text(face = "bold"),
axis.text.x = element_text(angle = 25, hjust = 1),
legend.position = "none"
)library(lme4)
model_pelvis <- lmer(
Pelvic_Angle ~ Material * Placement + (1 | Photograph),
data = anatomical_df
)## boundary (singular) fit: see help('isSingular')library(emmeans)
emm_pelvis <- emmeans(model_pelvis, ~ Material * Placement)## Cannot use mode = "kenward-roger" because *pbkrtest* package is not installedemm_pelvis_df <- as.data.frame(confint(emm_pelvis))
emm_pelvis_df$Placement <- factor(
emm_pelvis_df$Placement,
levels = c("L1-L5", "T1-T6", "T7-T12")
)
emm_pelvis_df$Material <- factor(
emm_pelvis_df$Material,
levels = c("Control", "Latex", "Memory foam", "Polyfoam")
)
library(ggplot2)
ggplot(emm_pelvis_df, aes(x = Material, y = emmean, color = Material, group = 1)) +
geom_errorbar(aes(ymin = lower.CL, ymax = upper.CL),
width = 0.18, linewidth = 1.1) +
geom_line(linewidth = 0.9, color = "gray35") +
geom_point(size = 4) +
facet_wrap(~Placement, nrow = 1) +
theme_classic(base_size = 13) +
labs(title = "Effect of Material on Pelvic Angle by Region",
x = "Material",
y = "Estimated Pelvic Angle (°)") +
theme(
strip.background = element_rect(fill = "white", color = "black"),
strip.text = element_text(face = "bold"),
axis.text.x = element_text(angle = 25, hjust = 1),
legend.position = "none"
)summary(model_pelvis)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: Pelvic_Angle ~ Material * Placement + (1 | Photograph)
## Data: anatomical_df
##
## REML criterion at convergence: 221.9
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.2071 -0.5205 -0.0433 0.5493 2.5822
##
## Random effects:
## Groups Name Variance Std.Dev.
## Photograph (Intercept) 0.0000 0.0000
## Residual 0.1808 0.4252
## Number of obs: 180, groups: Photograph, 5
##
## Fixed effects:
## Estimate Std. Error df t value
## (Intercept) 11.578800 0.109798 168.000000 105.456
## MaterialLatex -1.831933 0.155277 168.000000 -11.798
## MaterialMemory foam -3.488867 0.155277 168.000000 -22.469
## MaterialPolyfoam -5.801467 0.155277 168.000000 -37.362
## PlacementT1-T6 -0.029267 0.155277 168.000000 -0.188
## PlacementT7-T12 -0.004933 0.155277 168.000000 -0.032
## MaterialLatex:PlacementT1-T6 28.848533 0.219595 168.000000 131.372
## MaterialMemory foam:PlacementT1-T6 29.896267 0.219595 168.000000 136.143
## MaterialPolyfoam:PlacementT1-T6 34.753733 0.219595 168.000000 158.263
## MaterialLatex:PlacementT7-T12 18.385867 0.219595 168.000000 83.726
## MaterialMemory foam:PlacementT7-T12 19.380800 0.219595 168.000000 88.257
## MaterialPolyfoam:PlacementT7-T12 21.743533 0.219595 168.000000 99.017
## Pr(>|t|)
## (Intercept) <2e-16 ***
## MaterialLatex <2e-16 ***
## MaterialMemory foam <2e-16 ***
## MaterialPolyfoam <2e-16 ***
## PlacementT1-T6 0.851
## PlacementT7-T12 0.975
## MaterialLatex:PlacementT1-T6 <2e-16 ***
## MaterialMemory foam:PlacementT1-T6 <2e-16 ***
## MaterialPolyfoam:PlacementT1-T6 <2e-16 ***
## MaterialLatex:PlacementT7-T12 <2e-16 ***
## MaterialMemory foam:PlacementT7-T12 <2e-16 ***
## MaterialPolyfoam:PlacementT7-T12 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) MtrlLt MtrlMf MtrlPl PT1-T6 PT7-T1 ML:PT1 MMf:PT1 MP:PT1
## MaterialLtx -0.707
## MatrlMmryfm -0.707 0.500
## MaterlPlyfm -0.707 0.500 0.500
## PlcmntT1-T6 -0.707 0.500 0.500 0.500
## PlcmnT7-T12 -0.707 0.500 0.500 0.500 0.500
## MtrL:PT1-T6 0.500 -0.707 -0.354 -0.354 -0.707 -0.354
## MtMf:PT1-T6 0.500 -0.354 -0.707 -0.354 -0.707 -0.354 0.500
## MtrP:PT1-T6 0.500 -0.354 -0.354 -0.707 -0.707 -0.354 0.500 0.500
## MtL:PT7-T12 0.500 -0.707 -0.354 -0.354 -0.354 -0.707 0.500 0.250 0.250
## MMf:PT7-T12 0.500 -0.354 -0.707 -0.354 -0.354 -0.707 0.250 0.500 0.250
## MtP:PT7-T12 0.500 -0.354 -0.354 -0.707 -0.354 -0.707 0.250 0.250 0.500
## ML:PT7 MMf:PT7
## MaterialLtx
## MatrlMmryfm
## MaterlPlyfm
## PlcmntT1-T6
## PlcmnT7-T12
## MtrL:PT1-T6
## MtMf:PT1-T6
## MtrP:PT1-T6
## MtL:PT7-T12
## MMf:PT7-T12 0.500
## MtP:PT7-T12 0.500 0.500
## optimizer (nloptwrap) convergence code: 0 (OK)
## boundary (singular) fit: see help('isSingular')anova(model_pelvis)emm_pelvis## Material Placement emmean SE df lower.CL upper.CL
## Control L1-L5 11.58 0.11 168 11.36 11.80
## Latex L1-L5 9.75 0.11 168 9.53 9.96
## Memory foam L1-L5 8.09 0.11 168 7.87 8.31
## Polyfoam L1-L5 5.78 0.11 168 5.56 5.99
## Control T1-T6 11.55 0.11 168 11.33 11.77
## Latex T1-T6 38.57 0.11 168 38.35 38.78
## Memory foam T1-T6 37.96 0.11 168 37.74 38.17
## Polyfoam T1-T6 40.50 0.11 168 40.29 40.72
## Control T7-T12 11.57 0.11 168 11.36 11.79
## Latex T7-T12 28.13 0.11 168 27.91 28.34
## Memory foam T7-T12 27.47 0.11 168 27.25 27.68
## Polyfoam T7-T12 27.52 0.11 168 27.30 27.73
##
## Degrees-of-freedom method: satterthwaite
## Confidence level used: 0.95library(lme4)
library(emmeans)
library(ggplot2)
library(dplyr)
library(patchwork)
emm_spine_df <- as.data.frame(confint(emmeans(model_spine, ~ Material * Placement)))## Cannot use mode = "kenward-roger" because *pbkrtest* package is not installedemm_pelvis_df <- as.data.frame(confint(emmeans(model_pelvis, ~ Material * Placement)))## Cannot use mode = "kenward-roger" because *pbkrtest* package is not installedmaterial_levels <- c("Control", "Latex", "Memory foam", "Polyfoam")
placement_levels <- c("L1-L5", "T1-T6", "T7-T12")
emm_spine_df$Material <- factor(emm_spine_df$Material, levels = material_levels)
emm_spine_df$Placement <- factor(emm_spine_df$Placement, levels = placement_levels)
emm_pelvis_df$Material <- factor(emm_pelvis_df$Material, levels = material_levels)
emm_pelvis_df$Placement <- factor(emm_pelvis_df$Placement, levels = placement_levels)
my_theme <- theme_classic(base_size = 13) +
theme(
strip.background = element_rect(fill = "white", color = "black"),
strip.text = element_text(face = "bold"),
axis.text.x = element_text(angle = 25, hjust = 1),
legend.position = "none"
)
p_spine <- ggplot(emm_spine_df,
aes(x = Material, y = emmean, color = Material, group = 1)) +
geom_line(linewidth = 0.9, color = "gray35") +
geom_point(size = 3.5) +
facet_wrap(~Placement, nrow = 1) +
labs(
title = "A. Effect of Material on Spinal Angle by Region",
x = "Material",
y = "Estimated Spinal Angle (°)"
) +
my_theme
p_pelvis <- ggplot(emm_pelvis_df,
aes(x = Material, y = emmean, color = Material, group = 1)) +
geom_line(linewidth = 0.9, color = "gray35") +
geom_point(size = 3.5) +
facet_wrap(~Placement, nrow = 1) +
labs(
title = "B. Effect of Material on Pelvic Angle by Region",
x = "Material",
y = "Estimated Pelvic Angle (°)"
) +
my_theme
combined_plot <- p_spine / p_pelviscombined_plot