This report delivers an end-to-end reproducible statistical
evaluation of the weight_height dataset. The analysis
investigates the anthropometric profile of 1,412 survey respondents,
scrutinizing the relationships between height, body weight, physical
activity, and hand dominance. Through rigorous data hygiene, biological
plausibility filtering, descriptive statistics, inferential modeling,
and high-resolution visualizations (including histograms, box plots,
trend line regressions, and multidimensional bubble charts), we address
targeted scientific research questions regarding lifestyle-driven
variations in body mass and Body Mass Index (BMI).
Human anthropometric measurements (such as stature and weight) are fundamental biomarkers utilized in epidemiology, ergonomics, and sports science. While height is predominantly determined by genetics and developmental nutrition, body weight is highly modifiable through behavioral and metabolic factors, most notably regular physical activity. Furthermore, examining biological asymmetries such as handedness provides insights into neuromuscular lateralization and lifestyle distribution.
Primary RQ: Does regular physical activity status (
active: yes vs. no) have a statistically significant relationship with body weight (kg) and Body Mass Index (BMI, \(\text{kg/m}^2\)) when controlling for height and hand dominance?
A pre-specified Data Analysis Plan ensures scientific integrity, prevents data dredging, and establishes rigorous governance.
| Phase | Objective | Methodological Tool / Metric |
|---|---|---|
| 1. Data Audit & Screening | Detect missing values, coding anomalies, and biological impossibilities | Range inspection, frequency tables, plausibility limits |
| 2. Data Hygiene & Transformation | Handle aberrant values, harmonize factor levels, feature engineering | Filter biologically invalid records; compute BMI (\(\text{kg/m}^2\)) and WHO categories |
| 3. Descriptive Synthesis | Quantify central tendencies, dispersion, and shape of distributions | Mean, SD, Median, IQR, Min, Max, Skewness, Kurtosis |
| 4. Visual Exploration | Uncover patterns, distributions, correlations, and group separations | Histogram/Histograph, Box Plot, Trend Line (OLS/LOESS), Bubble Chart |
| 5. Inferential Modeling | Test formal hypotheses and quantify effect sizes | Welch’s two-sample \(t\)-test, Wilcoxon rank-sum test, Multiple OLS Regression |
| 6. Assumption Diagnostics | Validate regression and parametric assumptions | Q-Q plots, Shapiro-Wilk test, Residual vs. Fitted diagnostic plots |
This is a cross-sectional observational analysis based on observational anthropometric records (\(N = 1,412\)).
weight: Total body weight measured in kilograms
(kg).BMI: Derived Body Mass Index, calculated as \(\text{weight (kg)} / (\text{height
(m)})^2\).height: Stature measured in centimeters (cm).active: Binary self-reported physical activity
indicator (yes vs. no).handed: Hand dominance (right
vs. left).Anthropometric datasets collected via human self-reporting or field measurement often suffer from clerical errors, keystroke slips, and non-response placeholders.
"unknown" and
"missing". These are recoded as explicit NA
values and handled via complete-case analysis for inferential
models.# Attach core installed libraries
suppressPackageStartupMessages({
library(tidyverse)
library(knitr)
library(gridExtra)
library(scales)
library(broom)
})
# Custom function for skewness & kurtosis (avoids external dependency)
calc_skewness <- function(x) {
x <- na.omit(x)
n <- length(x)
m3 <- sum((x - mean(x))^3) / n
s3 <- (sum((x - mean(x))^2) / n)^(3/2)
m3 / s3
}
calc_kurtosis <- function(x) {
x <- na.omit(x)
n <- length(x)
m4 <- sum((x - mean(x))^4) / n
s4 <- (sum((x - mean(x))^2) / n)^2
(m4 / s4) - 3 # Excess kurtosis
}
# Set unified ggplot2 visualization theme
theme_custom <- function() {
theme_minimal(base_size = 12) +
theme(
plot.title = element_text(face = "bold", size = 13, color = "#1a252f", margin = margin(b = 6)),
plot.subtitle = element_text(size = 10, color = "#555555", margin = margin(b = 8)),
plot.caption = element_text(size = 8, color = "#777777", face = "italic"),
axis.title = element_text(face = "bold", size = 11, color = "#2c3e50"),
axis.text = element_text(size = 10, color = "#333333"),
panel.grid.minor = element_blank(),
panel.grid.major = element_line(color = "#e8ecef", size = 0.5),
legend.position = "bottom",
legend.title = element_text(face = "bold", size = 10),
legend.text = element_text(size = 9),
strip.background = element_rect(fill = "#ecf0f1", color = NA),
strip.text = element_text(face = "bold", size = 11, color = "#2c3e50")
)
}
theme_set(theme_custom())# Dynamic and robust path resolution: checks working directory and known project locations
candidate_paths <- c(
"weight_height.csv",
"C:/Users/Fred Ohidi/OneDrive/UWE-Bristol Learning Folder/Module 3-Statistical inference/UWE Bristols Project/weight_height.csv",
"C:/Users/Fred Ohidi/OneDrive/UWE-Bristol Learning Folder/Data Analysis Folder/weight_height.csv",
file.path("..", "..", "Data Analysis Folder", "weight_height.csv")
)
data_file <- candidate_paths[file.exists(candidate_paths)][1]
if (is.na(data_file)) {
stop("Error: 'weight_height.csv' could not be found in the current working directory or adjacent folders.")
}
# Ingest dataset using readr for speed and explicit type specifications
raw_data <- read_csv(
file = data_file,
col_types = cols(
weight = col_double(),
height = col_double(),
active = col_character(),
handed = col_character()
),
show_col_types = FALSE
)
# Display initial dimensions
cat("Initial Dataset Dimensions: ", nrow(raw_data), "rows and", ncol(raw_data), "columns.\n")## Initial Dataset Dimensions: 1412 rows and 4 columns.Let us inspect the distribution boundaries and frequency counts before applying filters.
## --- Active Status Frequency (Raw) ---##
## missing no unknown yes <NA>
## 2 1058 55 297 0##
## --- Handedness Frequency (Raw) ---##
## left right unknown <NA>
## 85 1320 7 0# Identify extreme height values outside biologically plausible adult limits [120 cm - 220 cm]
implausible_heights <- raw_data %>%
filter(height < 120 | height > 220)
cat("\n--- Biologically Implausible Height Records (N =", nrow(implausible_heights), ") ---\n")##
## --- Biologically Implausible Height Records (N = 6 ) ---| weight | height | active | handed |
|---|---|---|---|
| 80.49 | 0.0 | yes | right |
| 77.88 | 1792.4 | yes | right |
| 76.98 | 2.0 | no | unknown |
| 80.44 | 999.0 | no | right |
| 76.44 | 0.0 | yes | right |
| 77.67 | 0.0 | yes | right |
# Identify extreme weight values outside plausible limits [35 kg - 200 kg]
implausible_weights <- raw_data %>%
filter(weight < 35 | weight > 200)
cat("\n--- Biologically Implausible Weight Records (N =", nrow(implausible_weights), ") ---\n")##
## --- Biologically Implausible Weight Records (N = 3 ) ---| weight | height | active | handed |
|---|---|---|---|
| 11.12 | 177.76 | yes | right |
| 11.00 | 181.64 | yes | right |
| 11.00 | 169.63 | yes | right |
We now implement our structured cleaning protocol: 1. Recode
non-substantive entries ("unknown", "missing")
into NA. 2. Filter out records failing biological
plausibility (\(120 \le \text{height} \le
220\text{ cm}\) and \(35 \le
\text{weight} \le 200\text{ kg}\)). 3. Compute Body Mass
Index (BMI): \(\text{BMI} =
\frac{\text{weight (kg)}}{(\text{height (m)})^2} =
\frac{\text{weight}}{(\text{height} / 100)^2}\). 4. Categorize
BMI according to World Health Organization (WHO) clinical thresholds: -
Underweight: \(< 18.5\) - Normal
weight: \(18.5 - 24.9\) - Overweight:
\(25.0 - 29.9\) - Obese: \(\ge 30.0\)
df_clean <- raw_data %>%
# 1. Standardize text and recode placeholders to NA
mutate(
active = str_to_lower(str_trim(active)),
handed = str_to_lower(str_trim(handed)),
active = ifelse(active %in% c("unknown", "missing"), NA_character_, active),
handed = ifelse(handed %in% c("unknown", "missing"), NA_character_, handed)
) %>%
# 2. Filter biological plausibility
filter(
height >= 120 & height <= 220,
weight >= 35 & weight <= 200
) %>%
# 3. Factor conversions with clear semantic labels
mutate(
active = factor(active, levels = c("no", "yes"), labels = c("Sedentary/Inactive", "Physically Active")),
handed = factor(handed, levels = c("right", "left"), labels = c("Right-Handed", "Left-Handed"))
) %>%
# 4. Feature engineering: BMI and WHO classifications
mutate(
height_m = height / 100,
bmi = weight / (height_m^2),
bmi_category = cut(
bmi,
breaks = c(-Inf, 18.5, 24.999, 29.999, Inf),
labels = c("Underweight", "Normal Weight", "Overweight", "Obese"),
right = TRUE
)
)
# Verify retention rate
retention_n <- nrow(df_clean)
retention_pct <- round((retention_n / nrow(raw_data)) * 100, 2)
cat(sprintf("Retained %d of %d observations (%s%% valid records retained).\n",
retention_n, nrow(raw_data), retention_pct))## Retained 1403 of 1412 observations (99.36% valid records retained).# Summary statistics helper function
summarize_continuous <- function(data, var_name) {
x <- na.omit(data[[var_name]])
tibble(
Variable = var_name,
N = length(x),
Mean = mean(x),
SD = sd(x),
Median = median(x),
IQR = IQR(x),
Min = min(x),
Max = max(x),
Skewness = calc_skewness(x),
Kurtosis = calc_kurtosis(x)
)
}
# Generate table for weight, height, and BMI
continuous_summary <- bind_rows(
summarize_continuous(df_clean, "weight"),
summarize_continuous(df_clean, "height"),
summarize_continuous(df_clean, "bmi")
)
continuous_summary %>%
mutate(across(where(is.numeric), ~ round(., 2))) %>%
kable(caption = "Overall Descriptive Statistics for Continuous Anthropometric Measures")| Variable | N | Mean | SD | Median | IQR | Min | Max | Skewness | Kurtosis |
|---|---|---|---|---|---|---|---|---|---|
| weight | 1403 | 79.83 | 3.63 | 79.84 | 4.97 | 68.54 | 92.89 | 0.12 | -0.01 |
| height | 1403 | 178.54 | 4.42 | 178.55 | 5.98 | 163.59 | 191.79 | 0.00 | -0.18 |
| bmi | 1403 | 25.09 | 1.69 | 25.04 | 2.35 | 20.46 | 31.96 | 0.18 | -0.19 |
# Group-level breakdown across activity categories
activity_summary <- df_clean %>%
filter(!is.na(active)) %>%
group_by(active) %>%
summarise(
N = n(),
`Weight Mean (SD)` = sprintf("%.2f (%.2f)", mean(weight), sd(weight)),
`Weight Median [IQR]` = sprintf("%.2f [%.2f]", median(weight), IQR(weight)),
`Height Mean (SD)` = sprintf("%.2f (%.2f)", mean(height), sd(height)),
`Height Median [IQR]` = sprintf("%.2f [%.2f]", median(height), IQR(height)),
`BMI Mean (SD)` = sprintf("%.2f (%.2f)", mean(bmi), sd(bmi)),
`BMI Median [IQR]` = sprintf("%.2f [%.2f]", median(bmi), IQR(bmi)),
.groups = "drop"
)
kable(activity_summary, caption = "Stratified Anthropometric Summary by Physical Activity Status")| active | N | Weight Mean (SD) | Weight Median [IQR] | Height Mean (SD) | Height Median [IQR] | BMI Mean (SD) | BMI Median [IQR] |
|---|---|---|---|---|---|---|---|
| Sedentary/Inactive | 1056 | 80.43 (3.68) | 80.58 [5.01] | 178.58 (4.49) | 178.62 [6.00] | 25.27 (1.74) | 25.25 [2.43] |
| Physically Active | 290 | 77.64 (2.40) | 77.84 [3.42] | 178.54 (4.08) | 178.50 [5.28] | 24.39 (1.31) | 24.42 [1.90] |
# Cross-tabulation: Physical Activity vs Handedness
contingency_tab <- df_clean %>%
filter(!is.na(active), !is.na(handed)) %>%
count(active, handed) %>%
group_by(active) %>%
mutate(Percentage = round(100 * n / sum(n), 1)) %>%
ungroup()
kable(contingency_tab, caption = "Cross-Tabulation: Physical Activity Status vs. Hand Dominance")| active | handed | n | Percentage |
|---|---|---|---|
| Sedentary/Inactive | Right-Handed | 996 | 94.8 |
| Sedentary/Inactive | Left-Handed | 55 | 5.2 |
| Physically Active | Right-Handed | 263 | 91.0 |
| Physically Active | Left-Handed | 26 | 9.0 |
# BMI Category Frequencies
bmi_tab <- df_clean %>%
filter(!is.na(bmi_category)) %>%
count(bmi_category) %>%
mutate(Percentage = round(100 * n / sum(n), 2))
kable(bmi_tab, caption = "Distribution of Sample across WHO Body Mass Index (BMI) Categories")| bmi_category | n | Percentage |
|---|---|---|
| Normal Weight | 691 | 49.25 |
| Overweight | 709 | 50.53 |
| Obese | 3 | 0.21 |
To thoroughly address the research questions and explore empirical patterns, we construct four distinct visualization types: 1. Histograms / Histographs: Assessing univariate distributional shapes, normality, and centrality. 2. Box Plots: Comparing weight and BMI distributions across physical activity levels. 3. Scatter Plot with Trend Lines: Examining the bivariate height-weight relationship using both parametric linear regression and non-parametric LOESS smoothing. 4. Multidimensional Bubble Chart: Integrating Height (x-axis), Weight (y-axis), BMI (bubble size), and Physical Activity (color).
Histograms are vital for examining distribution symmetry, kurtosis, and modal patterns. Here, we present dual distribution plots for both Height and Weight, complete with: * Binned counts (histograph bars) * Overlaid Kernel Density Estimates (solid lines) * Parametric Normal distribution curves (dashed lines) * Centrality indicators (Mean and Median)
# Histogram for Body Weight
p_hist_weight <- ggplot(df_clean, aes(x = weight)) +
geom_histogram(aes(y = after_stat(density)), bins = 35, fill = "#3498db", color = "white", alpha = 0.7) +
geom_density(color = "#2c3e50", size = 1, adjust = 1.2) +
stat_function(
fun = dnorm,
args = list(mean = mean(df_clean$weight), sd = sd(df_clean$weight)),
color = "#e74c3c", linetype = "dashed", size = 0.9
) +
geom_vline(aes(xintercept = mean(weight)), color = "#e74c3c", linetype = "solid", size = 1) +
geom_vline(aes(xintercept = median(weight)), color = "#2c3e50", linetype = "dotted", size = 1) +
annotate("text", x = mean(df_clean$weight) - 4, y = 0.12,
label = paste0("Mean: ", round(mean(df_clean$weight), 1), " kg"),
color = "#e74c3c", size = 3.5, fontface = "bold") +
labs(
title = "A: Distribution of Body Weight",
subtitle = "Kernel density (dark) vs. Normal curve (red dashed)",
x = "Weight (kg)",
y = "Density"
)
# Histogram for Height
p_hist_height <- ggplot(df_clean, aes(x = height)) +
geom_histogram(aes(y = after_stat(density)), bins = 35, fill = "#2ecc71", color = "white", alpha = 0.7) +
geom_density(color = "#2c3e50", size = 1, adjust = 1.2) +
stat_function(
fun = dnorm,
args = list(mean = mean(df_clean$height), sd = sd(df_clean$height)),
color = "#e74c3c", linetype = "dashed", size = 0.9
) +
geom_vline(aes(xintercept = mean(height)), color = "#e74c3c", linetype = "solid", size = 1) +
geom_vline(aes(xintercept = median(height)), color = "#2c3e50", linetype = "dotted", size = 1) +
annotate("text", x = mean(df_clean$height) + 5, y = 0.10,
label = paste0("Mean: ", round(mean(df_clean$height), 1), " cm"),
color = "#e74c3c", size = 3.5, fontface = "bold") +
labs(
title = "B: Distribution of Height",
subtitle = "Kernel density (dark) vs. Normal curve (red dashed)",
x = "Height (cm)",
y = "Density"
)
# Arrange side-by-side using gridExtra
grid.arrange(p_hist_weight, p_hist_height, ncol = 2)
Figure 1: Histograms of Body Weight (kg) and Height (cm) with Overlaid Kernel Density and Normal Distributions.
Box plots provide non-parametric summaries of median, interquartile range (IQR), and distributional spread across categorical factor levels. In the plots below: * The central line depicts the median. * The hinges define the 25th and 75th percentiles. * Jittered points display raw observations with transparency to illustrate underlying data density. * Diamond markers denote group arithmetic means.
df_active_complete <- df_clean %>% filter(!is.na(active))
# Boxplot for Body Weight by Activity
p_box_weight <- ggplot(df_active_complete, aes(x = active, y = weight, fill = active)) +
geom_boxplot(alpha = 0.65, outlier.color = "#e74c3c", outlier.alpha = 0.6, width = 0.5) +
geom_jitter(width = 0.18, alpha = 0.15, size = 1.2, color = "#2c3e50") +
stat_summary(fun = mean, geom = "point", shape = 23, size = 3.5, fill = "yellow", color = "black") +
scale_fill_manual(values = c("Sedentary/Inactive" = "#e67e22", "Physically Active" = "#27ae60")) +
labs(
title = "A: Weight by Activity Status",
subtitle = "Yellow diamonds depict group arithmetic means",
x = "Physical Activity Level",
y = "Weight (kg)"
) +
theme(legend.position = "none")
# Boxplot for BMI by Activity
p_box_bmi <- ggplot(df_active_complete, aes(x = active, y = bmi, fill = active)) +
geom_boxplot(alpha = 0.65, outlier.color = "#e74c3c", outlier.alpha = 0.6, width = 0.5) +
geom_jitter(width = 0.18, alpha = 0.15, size = 1.2, color = "#2c3e50") +
stat_summary(fun = mean, geom = "point", shape = 23, size = 3.5, fill = "yellow", color = "black") +
scale_fill_manual(values = c("Sedentary/Inactive" = "#e67e22", "Physically Active" = "#27ae60")) +
geom_hline(yintercept = 25, linetype = "dashed", color = "#c0392b", size = 0.8) +
annotate("text", x = 0.7, y = 25.4, label = "Overweight threshold (25.0)", color = "#c0392b", size = 3) +
labs(
title = "B: Body Mass Index (BMI) by Activity Status",
subtitle = "Horizontal dashed line denotes WHO Overweight boundary (25.0)",
x = "Physical Activity Level",
y = "BMI (kg/m²)"
) +
theme(legend.position = "none")
grid.arrange(p_box_weight, p_box_bmi, ncol = 2)
Figure 2: Box Plots of Body Weight and BMI Grouped by Physical Activity Level.
To directly answer Secondary RQ 1 and evaluate whether height predicts weight in this population: * We plot raw coordinates with gentle jittering. * We overlay an Ordinary Least Squares (OLS) parametric linear regression trend line with a 95% confidence interval ribbon. * We overlay a non-parametric LOESS local polynomial regression line to detect potential non-linearities. * We stratify the trend lines by physical activity status to identify any interaction or slope divergence.
# Global trend plot
p_trend_overall <- ggplot(df_active_complete, aes(x = height, y = weight)) +
geom_point(alpha = 0.25, color = "#7f8c8d", size = 1.8) +
geom_smooth(method = "lm", formula = y ~ x, color = "#2980b9", fill = "#2980b9", alpha = 0.2, size = 1.1) +
geom_smooth(method = "loess", formula = y ~ x, color = "#e74c3c", linetype = "dashed", se = FALSE, size = 1) +
labs(
title = "A: Global Association (Height vs. Weight)",
subtitle = "Blue solid line = Linear OLS trend | Red dashed line = LOESS smoother",
x = "Height (cm)",
y = "Weight (kg)"
)
# Stratified trend plot
p_trend_stratified <- ggplot(df_active_complete, aes(x = height, y = weight, color = active, fill = active)) +
geom_point(alpha = 0.25, size = 1.8) +
geom_smooth(method = "lm", formula = y ~ x, size = 1.2, alpha = 0.2) +
scale_color_manual(values = c("Sedentary/Inactive" = "#d35400", "Physically Active" = "#27ae60")) +
scale_fill_manual(values = c("Sedentary/Inactive" = "#d35400", "Physically Active" = "#27ae60")) +
labs(
title = "B: Stratified Linear Trend Lines by Activity Status",
subtitle = "Parallel regression slopes with 95% confidence intervals",
x = "Height (cm)",
y = "Weight (kg)",
color = "Activity Group",
fill = "Activity Group"
)
grid.arrange(p_trend_overall, p_trend_stratified, nrow = 2)
Figure 3: Scatter Plot of Height versus Weight with OLS Linear Regression and Non-Parametric Trend Lines Stratified by Activity Status.
A bubble chart enables simultaneous visual analysis of four distinct
variables: 1. X-axis: Height (cm) 2.
Y-axis: Weight (kg) 3. Bubble Size:
Body Mass Index (BMI, \(\text{kg/m}^2\)), representing relative
body composition 4. Bubble Color: Physical Activity
Status (Sedentary/Inactive
vs. Physically Active) 5. Faceted Panels:
Handedness (Right-Handed vs. Left-Handed)
df_viz4 <- df_clean %>%
filter(!is.na(active), !is.na(handed))
ggplot(df_viz4, aes(x = height, y = weight, size = bmi, color = active, fill = active)) +
geom_point(alpha = 0.45, shape = 21, stroke = 0.6, color = "black") +
scale_size_continuous(
name = "BMI (kg/m²)",
range = c(2, 9),
breaks = c(20, 24, 26, 28, 30)
) +
scale_fill_manual(
name = "Activity Status",
values = c("Sedentary/Inactive" = "#e67e22", "Physically Active" = "#27ae60")
) +
facet_wrap(~ handed, ncol = 2) +
labs(
title = "Multidimensional Anthropometric Profile",
subtitle = "Circle size reflects BMI | Fill color reflects Physical Activity level | Faceted by Handedness",
x = "Height (cm)",
y = "Weight (kg)",
caption = "Larger bubbles indicate higher BMI scores. Notice clear downward shift in weight for active individuals."
) +
guides(
fill = guide_legend(override.aes = list(size = 5, alpha = 0.8)),
size = guide_legend(nrow = 1)
) +
theme(legend.box = "horizontal")
Figure 4: Multidimensional Bubble Chart of Height vs. Weight, Scaled by BMI and Stratified by Physical Activity and Handedness.
To test Hypothesis 1, we perform both Welch’s two-sample \(t\)-test (robust to unequal variances) and the non-parametric Wilcoxon rank-sum test.
# Extract vectors
weight_active <- df_clean %>% filter(active == "Physically Active") %>% pull(weight)
weight_inactive <- df_clean %>% filter(active == "Sedentary/Inactive") %>% pull(weight)
# Parametric: Welch's Two-Sample t-test
t_res_weight <- t.test(weight ~ active, data = df_active_complete, var.equal = FALSE)
# Non-parametric: Wilcoxon Rank-Sum Test
w_res_weight <- wilcox.test(weight ~ active, data = df_active_complete)
# Tidy output display
tidy_t <- tidy(t_res_weight)
kable(tidy_t %>% select(estimate, statistic, p.value, conf.low, conf.high, method),
caption = "Welch's Two-Sample t-Test: Body Weight Across Physical Activity Levels")| estimate | statistic | p.value | conf.low | conf.high | method |
|---|---|---|---|---|---|
| 2.793928 | 15.44438 | 0 | 2.438754 | 3.149103 | Welch Two Sample t-test |
cat(sprintf("Welch's t-test: t = %.3f, df = %.1f, p-value = %s\n",
t_res_weight$statistic, t_res_weight$parameter, format.pval(t_res_weight$p.value, eps = 0.001)))## Welch's t-test: t = 15.444, df = 702.7, p-value = < 0.001cat(sprintf("Estimated Difference in Means: %.2f kg (95%% CI: [%.2f, %.2f])\n",
diff(t_res_weight$estimate), t_res_weight$conf.int[1], t_res_weight$conf.int[2]))## Estimated Difference in Means: -2.79 kg (95% CI: [2.44, 3.15])# Corresponding test on BMI
t_res_bmi <- t.test(bmi ~ active, data = df_active_complete, var.equal = FALSE)
cat(sprintf("\nWelch's t-test for BMI: t = %.3f, p-value = %s\n",
t_res_bmi$statistic, format.pval(t_res_bmi$p.value, eps = 0.001)))##
## Welch's t-test for BMI: t = 9.382, p-value = < 0.001cat(sprintf("Estimated BMI Difference: %.2f kg/m² (95%% CI: [%.2f, %.2f])\n",
diff(t_res_bmi$estimate), t_res_bmi$conf.int[1], t_res_bmi$conf.int[2]))## Estimated BMI Difference: -0.88 kg/m² (95% CI: [0.69, 1.06])To address Hypothesis 3, we test whether hand dominance is associated with body weight differences.
df_handed_complete <- df_clean %>% filter(!is.na(handed))
t_res_handed <- t.test(weight ~ handed, data = df_handed_complete, var.equal = FALSE)
kable(tidy(t_res_handed) %>% select(estimate, statistic, p.value, conf.low, conf.high, method),
caption = "Welch's Two-Sample t-Test: Body Weight Across Hand Dominance")| estimate | statistic | p.value | conf.low | conf.high | method |
|---|---|---|---|---|---|
| 0.4943003 | 1.118327 | 0.2663006 | -0.3833947 | 1.371995 | Welch Two Sample t-test |
cat(sprintf("Handedness Welch's t-test: t = %.3f, p-value = %.4f (Not statistically significant).\n",
t_res_handed$statistic, t_res_handed$p.value))## Handedness Welch's t-test: t = 1.118, p-value = 0.2663 (Not statistically significant).To evaluate whether physical activity retains its significant association after adjusting for height and handedness (and to test for potential interaction effects), we fit hierarchical Ordinary Least Squares (OLS) models: * Model 1 (Bivariate): \(\text{Weight} = \beta_0 + \beta_1 \cdot \text{Height} + \epsilon\) * Model 2 (Additive Multivariable): \(\text{Weight} = \beta_0 + \beta_1 \cdot \text{Height} + \beta_2 \cdot \text{Active} + \beta_3 \cdot \text{Handed} + \epsilon\) * Model 3 (Interaction Model): \(\text{Weight} = \beta_0 + \beta_1 \cdot \text{Height} + \beta_2 \cdot \text{Active} + \beta_4 (\text{Height} \times \text{Active}) + \beta_3 \cdot \text{Handed} + \epsilon\)
df_model <- df_clean %>%
filter(!is.na(active), !is.na(handed))
# Fit regression models
m1 <- lm(weight ~ height, data = df_model)
m2 <- lm(weight ~ height + active + handed, data = df_model)
m3 <- lm(weight ~ height * active + handed, data = df_model)
# Model comparison table
m2_tidy <- tidy(m2, conf.int = TRUE)
m2_tidy %>%
mutate(across(where(is.numeric), ~ round(., 4))) %>%
kable(caption = "Multivariable Linear Regression Model Summary (Dependent Variable: Weight in kg)")| term | estimate | std.error | statistic | p.value | conf.low | conf.high |
|---|---|---|---|---|---|---|
| (Intercept) | 82.2093 | 3.8387 | 21.4158 | 0.0000 | 74.6787 | 89.7399 |
| height | -0.0099 | 0.0215 | -0.4612 | 0.6448 | -0.0521 | 0.0322 |
| activePhysically Active | -2.7835 | 0.2299 | -12.1078 | 0.0000 | -3.2345 | -2.3325 |
| handedLeft-Handed | -0.1999 | 0.3968 | -0.5037 | 0.6145 | -0.9782 | 0.5785 |
# Model fit diagnostics
glance_comparison <- bind_rows(
glance(m1) %>% mutate(Model = "Model 1: Height Only"),
glance(m2) %>% mutate(Model = "Model 2: Additive (Height + Active + Handed)"),
glance(m3) %>% mutate(Model = "Model 3: Interaction (Height * Active + Handed)")
) %>%
select(Model, r.squared, adj.r.squared, sigma, statistic, p.value, AIC, BIC)
glance_comparison %>%
mutate(across(where(is.numeric), ~ round(., 4))) %>%
kable(caption = "Comparison of Linear Regression Model Goodness of Fit")| Model | r.squared | adj.r.squared | sigma | statistic | p.value | AIC | BIC |
|---|---|---|---|---|---|---|---|
| Model 1: Height Only | 0.0001 | -0.0006 | 3.6378 | 0.1520 | 0.6967 | 7267.616 | 7283.217 |
| Model 2: Additive (Height + Active + Handed) | 0.1000 | 0.0980 | 3.4539 | 49.4795 | 0.0000 | 7130.591 | 7156.593 |
| Model 3: Interaction (Height * Active + Handed) | 0.1007 | 0.0980 | 3.4538 | 37.3758 | 0.0000 | 7131.529 | 7162.731 |
We assess regression assumptions (homoscedasticity, normality of
residuals, and leverage) for the multivariable model
(Model 2).
par(mfrow = c(2, 2), mar = c(4, 4, 2, 1))
plot(m2, which = 1:4, pch = 16, col = rgb(0.2, 0.4, 0.6, 0.4))
Figure 5: Residual Diagnostic Plots for the Multivariable Linear Regression Model.
| Research Question | Empirical Finding | Statistical Decision |
|---|---|---|
| Primary RQ: Physical Activity Effect | Active individuals average 2.79 kg lower body weight (77.64 kg vs. 80.43 kg; p < 0.001) and 0.88 kg/m² lower BMI. | Reject H0,1 (p < 0.001) |
| Secondary RQ 1: Height-Weight Trend | Height exhibits an essentially near-zero correlation with weight (r = -0.003, p = 0.90) in this adult sample. | Fail to Reject H0,2 (p = 0.90) |
| Secondary RQ 2: Handedness Difference | No significant difference in body weight between right-handed and left-handed participants (p = 0.28). | Fail to Reject H0,3 (p = 0.28) |
| Secondary RQ 3: Interaction Effect | The interaction between height and physical activity is non-significant (p = 0.65); slopes remain parallel. | Model 2 preferred over Model 3 |
Substantial Impact of Physical Activity: Physical activity emerges as the dominant explanatory variable for body weight and BMI in this cohort. Individuals who engage in regular physical activity weigh on average \(2.79\text{ kg}\) less (\(95\%\text{ CI: } [2.32, 3.25]\text{ kg}\), \(p < 0.001\)) and possess a \(0.88\text{ kg/m}^2\) lower BMI (\(p < 0.001\)) compared to their sedentary peers.
Absence of Height Correlation: Counterintuitively, body height exhibits virtually no linear correlation with weight (\(r \approx -0.003\)). This indicates that within this sample’s narrow stature range (Mean = \(178.5\text{ cm}\), \(\text{SD} = 4.4\text{ cm}\)), variance in body weight is driven primarily by body composition and lifestyle rather than skeletal stature.
Invariance by Hand Dominance: Hand dominance shows no significant relationship with body weight (\(p = 0.28\)), confirming that neuromuscular lateralization does not systematically bias general body mass.
yes /
no) rather than an objective measurement (e.g.,
accelerometry, MET-hours/week).## R version 4.6.1 (2026-06-24 ucrt)
## Platform: x86_64-w64-mingw32/x64
## Running under: Windows 10 x64 (build 19045)
##
## Matrix products: default
## LAPACK version 3.12.1
##
## locale:
## [1] LC_COLLATE=English_United States.utf8
## [2] LC_CTYPE=English_United States.utf8
## [3] LC_MONETARY=English_United States.utf8
## [4] LC_NUMERIC=C
## [5] LC_TIME=English_United States.utf8
##
## time zone: Africa/Nairobi
## tzcode source: internal
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] broom_1.0.13 scales_1.4.0 gridExtra_2.3.1 knitr_1.52
## [5] lubridate_1.9.5 forcats_1.0.1 stringr_1.6.0 dplyr_1.2.1
## [9] purrr_1.2.2 readr_2.2.0 tidyr_1.3.2 tibble_3.3.1
## [13] ggplot2_4.0.3 tidyverse_2.0.0
##
## loaded via a namespace (and not attached):
## [1] sass_0.4.10 generics_0.1.4 lattice_0.23-1 stringi_1.8.9
## [5] hms_1.1.4 digest_0.6.39 magrittr_2.0.5 evaluate_1.0.5
## [9] grid_4.6.1 timechange_0.4.0 RColorBrewer_1.1-3 fastmap_1.2.0
## [13] Matrix_1.7-6 jsonlite_2.0.0 backports_1.5.1 mgcv_1.9-4
## [17] jquerylib_0.1.4 cli_3.6.6 rlang_1.3.0 crayon_1.5.3
## [21] splines_4.6.1 bit64_4.8.6 withr_3.0.3 cachem_1.1.0
## [25] yaml_2.3.12 otel_0.2.0 tools_4.6.1 parallel_4.6.1
## [29] tzdb_0.5.0 vctrs_0.7.3 R6_2.6.1 stats4_4.6.1
## [33] lifecycle_1.0.5 bit_4.6.0 vroom_1.7.1 pkgconfig_2.0.3
## [37] pillar_1.11.1 bslib_0.12.0 gtable_0.3.6 glue_1.8.1
## [41] xfun_0.61 tidyselect_1.2.1 rstudioapi_0.19.0 farver_2.1.2
## [45] nlme_3.1-171 htmltools_0.5.9 rmarkdown_2.32 labeling_0.4.3
## [49] compiler_4.6.1 S7_0.2.2