# SPDX-License-Identifier: AGPL-3.0-or-later
# Copyright (C) 2025 SWGY, Inc
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Affero General Public License for more details.
#
# You should have received a copy of the GNU Affero General Public License
# along with this program. If not, see <https://www.gnu.org/licenses/>.
#install.packages("ggplot2")
#install.packages("rgl")
library(ggplot2)
library(rgl)
ggplot(long_df, aes(x = ArmorCondition, y = Impulse)) +
geom_boxplot() +
theme_minimal()
ggplot(long_df, aes(x = ArmorCondition, y = Impulse)) +
geom_violin(trim=FALSE) +
geom_boxplot(width=0.1) +
theme_minimal()
# compute 95th percentile
# This version "zooms in" to the interesting part
q95 <- quantile(long_df$Impulse, .95)
ggplot(long_df, aes(ArmorCondition, Impulse)) +
geom_boxplot() +
coord_cartesian(ylim = c(0, q95)) +
theme_minimal()
# The log scale can help with seeing detail. It offers perhaps the
# best view, and makes sense given the spherical drop-off of the pressure wave
ggplot(long_df, aes(ArmorCondition, Impulse)) +
geom_boxplot() +
scale_y_log10() +
theme_minimal()
ggplot(long_df, aes(x = ArmorCondition, y = Impulse)) +
geom_violin(trim=FALSE) +
geom_boxplot(width=0.1) +
scale_y_log10() +
theme_minimal()
df$diff_full_no <- df$full_armor - df$no_armor
df$diff_full_helmet <- df$full_armor - df$helmet_only
df$diff_vest_no <- df$vest_only - df$no_armor
with(df, {
plot3d(
x = bp_x,
y = bp_y,
z = bp_z,
col = heat.colors(100)[as.numeric(cut(diff_full_no, 100))],
size = 5,
type = "s"
)
})
intermediate_df$diff_full_no <- intermediate_df$full_armor - intermediate_df$no_armor
intermediate_df$diff_full_helmet <- intermediate_df$full_armor - intermediate_df$helmet_only
intermediate_df$diff_vest_no <- intermediate_df$vest_only - intermediate_df$no_armor
# signed log: compress both positive & negative extremes
intermediate_df$diff_log <- sign(intermediate_df$diff_full_no) *
log1p(abs(intermediate_df$diff_full_no))
# then bin & color
col_idx <- as.numeric(cut(intermediat_df$diff_log, breaks = 100))
cols <- heat.colors(100)[col_idx]
with(intermediate_df, {
plot3d(
bp_x, bp_y, bp_z,
col = cols,
size = 1.7,
type = "s"
)
})
# 1) Filter to just the two conditions and set factor order
df2 <- intermediate_long %>%
filter(ArmorCondition %in% c("helmet_only", "vest_only")) %>%
mutate(ArmorCondition = factor(ArmorCondition, levels = c("helmet_only", "vest_only")))
# 2) Compute condition means
means <- df2 %>%
group_by(ArmorCondition) %>%
summarize(mean_impulse = mean(Impulse, na.rm = TRUE))
# 3) Plot
ggplot(df2, aes(x = ArmorCondition, y = Impulse)) +
# subject‐level trajectories
geom_line(aes(group = subject_id), color = "grey70", alpha = 0.6) +
geom_point(aes(group = subject_id), color = "grey50", alpha = 0.6) +
# overlay the means in red
geom_point(data = means,
aes(x = ArmorCondition, y = mean_impulse),
color = "red", size = 3) +
geom_line(data = means,
aes(x = ArmorCondition, y = mean_impulse, group = 1),
color = "red", size = 1.2) +
theme_minimal() +
labs(
title = "Intermediate Blasts: Helmet vs Vest",
subtitle = "Grey lines = each blast point; red = group means",
x = "Armor Condition",
y = "Impulse"
)
# 1) Filter to just the two conditions and set factor order
df2 <- intermediate_long %>%
filter(ArmorCondition %in% c("full_armor", "helmet_only")) %>%
mutate(ArmorCondition = factor(ArmorCondition, levels = c("full_armor", "helmet_only")))
# 2) Compute condition means
means <- df2 %>%
group_by(ArmorCondition) %>%
summarize(mean_impulse = mean(Impulse, na.rm = TRUE))
# 3) Plot
ggplot(df2, aes(x = ArmorCondition, y = Impulse)) +
# subject‐level trajectories
geom_line(aes(group = subject_id), color = "grey70", alpha = 0.6) +
geom_point(aes(group = subject_id), color = "grey50", alpha = 0.6) +
# overlay the means in red
geom_point(data = means,
aes(x = ArmorCondition, y = mean_impulse),
color = "red", size = 3) +
geom_line(data = means,
aes(x = ArmorCondition, y = mean_impulse, group = 1),
color = "red", size = 1.2) +
theme_minimal() +
labs(
title = "Intermediate Blasts: Full Armor vs Vest Only",
subtitle = "Grey lines = each blast point; red = group means",
x = "Armor Condition",
y = "Impulse"
)