library(ggplot2)
library(gridExtra)
# Parameters
x_max <- 100; t_max <- 50
nx <- 200; nt <- 500
x <- seq(0, x_max, length.out = nx)
t <- seq(0, t_max, length.out = nt)
# Wave physics
c <- 1.0 # Speed of light
gamma_standard <- 0.0 # Standard GR: no damping
gamma_ifield <- 0.08 # Modified: damping
phase_delay <- 0.15 # Phase delay parameter
# Initial amplitude and frequencies
A0 <- 1.0
f1 <- 0.1 # Inspiral frequency
f2 <- 0.2 # Ringdown frequencyYou Can Do Physics with R: Simulating Gravitational Waves
physics
simulation
gravitational-waves
visualization
When LIGO Shook Physics
In 2015, LIGO detected gravitational waves—ripples in spacetime from colliding black holes 1.3 billion light-years away. Einstein predicted them in 1916. It took a century to confirm.
Today, we’ll simulate them. In R.
The Physics in 30 Seconds
Gravitational waves travel at light speed through space. Standard physics says they propagate forever, unchanged. But what if there’s a subtle damping effect? A modification to Einstein’s equations?
We’ll compare two scenarios:
- Standard: Wave travels unchanged
- Modified: Wave experiences damping + phase delay
This tests a fundamental theory called the Entropic I-Field, which proposes that irreversibility is built into physics at the deepest level.
The Math (Don’t Panic!)
The wave equation with damping is surprisingly simple:
\[ \frac{\partial^2 h}{\partial t^2} - c^2 \frac{\partial^2 h}{\partial x^2} + \gamma \frac{\partial h}{\partial t} = 0 \]
- \(h\) = strain (how much space stretches)
- \(c\) = speed of light
- \(\gamma\) = damping coefficient (zero in standard physics, small but nonzero in our modified theory)
Instead of finite-difference methods (which can be numerically unstable), we’ll use traveling wave packets with explicit damping envelopes. This is more stable and physically intuitive.
The R Code
Here’s the complete simulation. It’s ~100 lines and runs in seconds:
Define Wave Solutions
Standard physics: no damping, full amplitude.
# Standard GR wave (no damping)
wave_standard <- function(x, t, x0 = 20) {
inspiral <- exp(-0.5*((x - x0 - c*t)/3)^2) * sin(2*pi*f1*(x - c*t))
ringdown <- exp(-0.5*((x - x0 - 10 - c*t)/2)^2) * sin(2*pi*f2*(x - c*t))
return(A0 * (inspiral + 0.7*ringdown))
}
# I-Field modified: damping envelope + phase delay
wave_ifield <- function(x, t, x0 = 20) {
damping_envelope <- exp(-gamma_ifield * t)
effective_distance <- x - x0 - c*t*(1 - phase_delay)
inspiral <- exp(-0.5*(effective_distance/3)^2) * sin(2*pi*f1*effective_distance)
ringdown <- exp(-0.5*((effective_distance - 10)/2)^2) * sin(2*pi*f2*effective_distance)
return(A0 * damping_envelope * (inspiral + 0.7*ringdown))
}Compute Solutions
# Create solution matrices
h_standard <- matrix(0, nrow = nt, ncol = nx)
h_ifield <- matrix(0, nrow = nt, ncol = nx)
for (i in 1:nt) {
for (j in 1:nx) {
h_standard[i, j] <- wave_standard(x[j], t[i])
h_ifield[i, j] <- wave_ifield(x[j], t[i])
}
}Analyze at Detector
# "Detector" at fixed position
detector_x <- 70
detector_idx <- which.min(abs(x - detector_x))
# Time series at detector
h_std <- h_standard[, detector_idx]
h_ifd <- h_ifield[, detector_idx]
# Find peaks and calculate metrics
t_peak_std <- t[which.max(abs(h_std))]
t_peak_ifd <- t[which.max(abs(h_ifd))]
max_std <- max(abs(h_std))
max_ifd <- max(abs(h_ifd))
damping <- (1 - max_ifd/max_std) * 100
delay <- (t_peak_ifd - t_peak_std) / t_peak_std * 100
cat(sprintf("Amplitude reduction: %.1f%%\n", damping))Amplitude reduction: 98.0%cat(sprintf("Time delay: %.1f%%\n", delay))Time delay: -4.8%The Results
Three panels tell the story:
# Panel A: Detector time series
df_detector <- data.frame(time = t, Standard_GR = h_std, IField = h_ifd)
p1 <- ggplot(df_detector, aes(x = time)) +
geom_line(aes(y = Standard_GR, color = "Standard GR"), linewidth = 0.8, alpha = 0.7) +
geom_line(aes(y = IField, color = "I-Field"), linewidth = 1.0) +
geom_vline(xintercept = c(t_peak_std, t_peak_ifd),
linetype = "dashed", alpha = 0.5, color = c("blue", "red")) +
annotate("text", x = 2, y = max_std * 0.95, label = "A",
size = 10, fontface = "bold") +
annotate("segment", x = t_peak_std, xend = t_peak_ifd,
y = max_std * 0.65, yend = max_std * 0.65,
arrow = arrow(length = unit(0.3, "cm"), ends = "both"),
color = "darkred", linewidth = 1.2) +
scale_color_manual(values = c("Standard GR" = "blue", "I-Field" = "red")) +
labs(title = "Wave Detected at Fixed Position",
subtitle = sprintf("Damping: %.1f%% | Delay: %.1f%%", damping, delay),
x = "Time", y = "Strain h", color = "") +
theme_minimal(base_size = 12) +
theme(plot.title = element_text(face = "bold"), legend.position = "top")
# Panel B: Spatial snapshot
snapshot_idx <- which.min(abs(t - 25))
df_spatial <- data.frame(x = x,
Standard_GR = h_standard[snapshot_idx, ],
IField = h_ifield[snapshot_idx, ])
p2 <- ggplot(df_spatial, aes(x = x)) +
geom_line(aes(y = Standard_GR, color = "Standard GR"), linewidth = 0.8, alpha = 0.7) +
geom_line(aes(y = IField, color = "I-Field"), linewidth = 1.0) +
geom_vline(xintercept = detector_x, linetype = "dotted", color = "gray30") +
annotate("text", x = 2, y = max(df_spatial$Standard_GR) * 0.95,
label = "B", size = 10, fontface = "bold") +
scale_color_manual(values = c("Standard GR" = "blue", "I-Field" = "red")) +
labs(title = "Spatial Snapshot at t = 25",
subtitle = "Wave 'in flight' through space",
x = "Position x", y = "Strain h", color = "") +
theme_minimal(base_size = 12) +
theme(plot.title = element_text(face = "bold"), legend.position = "top")
# Panel C: Zoomed comparison
zoom_range <- (t >= t_peak_std - 4) & (t <= t_peak_ifd + 4)
df_zoom <- data.frame(time = t[zoom_range],
Standard_GR = h_std[zoom_range],
IField = h_ifd[zoom_range])
p3 <- ggplot(df_zoom, aes(x = time)) +
geom_line(aes(y = Standard_GR, color = "Standard GR"), linewidth = 1.2, alpha = 0.7) +
geom_line(aes(y = IField, color = "I-Field"), linewidth = 1.2) +
geom_vline(xintercept = c(t_peak_std, t_peak_ifd),
linetype = "dashed", color = c("blue", "red")) +
annotate("text", x = min(df_zoom$time) + 0.5, y = max(df_zoom$Standard_GR) * 0.95,
label = "C", size = 10, fontface = "bold") +
annotate("segment", x = t_peak_std, xend = t_peak_ifd, y = 0, yend = 0,
arrow = arrow(length = unit(0.4, "cm"), ends = "both"),
color = "purple", linewidth = 1.5) +
scale_color_manual(values = c("Standard GR" = "blue", "I-Field" = "red")) +
labs(title = "Phase Comparison (Zoomed)",
subtitle = "Clear time delay between peaks",
x = "Time", y = "Strain h", color = "") +
theme_minimal(base_size = 12) +
theme(plot.title = element_text(face = "bold"), legend.position = "top")
# Combine
grid.arrange(p1, p2, p3, ncol = 1)
Panel A shows the signal at a detector: the modified theory predicts lower amplitude and delayed arrival.
Panel B captures the wave mid-propagation: you can see both signals traveling through space.
Panel C zooms in on the time delay—this is what LIGO could potentially measure with enough events.
What This Means
If the I-Field theory is correct, gravitational waves should show:
- ~1-2% damping over cosmological distances
- Frequency-dependent effects (higher frequencies damp more)
- No corresponding redshift (distinguishes from cosmological expansion)
With 100+ binary black hole mergers detected by LIGO (and counting), we can statistically test this. Real physics, real predictions, real falsifiability.
Why R?
This simulation runs in under 2 seconds on a laptop. R isn’t just for statistics—it’s a complete scientific computing environment:
- Fast enough for physics simulations
- Excellent visualization (ggplot2 is unmatched)
- Reproducible (Quarto embeds code and output)
- Accessible (anyone can run this code)
Try It Yourself
All code is embedded above—just copy and run! Modify parameters:
- Change
gamma_ifield→ see stronger/weaker damping - Adjust frequencies
f1,f2→ simulate different sources - Vary
phase_delay→ test different theories
Want the complete standalone script? Email me at kritiker2017@gmail.com
Physics isn’t magic. It’s just differential equations and creative visualization.
Learn More
This simulation is part of a larger research project on fundamental irreversibility:
- Paper 1: “Entropic I-Field Theory” (under review, Springer Nature)
- Paper 2: “Numerical Validation” (in preparation)
The theory proposes that time’s arrow—why eggs break but don’t unbreak, why we age forward—is fundamental, not emergent. It makes testable predictions from gravitational waves to DNA replication to neural memory.
Questions? Comments? Find me at kritiker2017@gmail.com
Enjoy physics with R! 🚀
Session Info
sessionInfo()R version 4.4.2 (2024-10-31 ucrt)
Platform: x86_64-w64-mingw32/x64
Running under: Windows 11 x64 (build 26200)
Matrix products: default
locale:
[1] LC_COLLATE=German_Germany.utf8 LC_CTYPE=German_Germany.utf8
[3] LC_MONETARY=German_Germany.utf8 LC_NUMERIC=C
[5] LC_TIME=German_Germany.utf8
time zone: Europe/Berlin
tzcode source: internal
attached base packages:
[1] stats graphics grDevices datasets parallel utils methods
[8] base
other attached packages:
[1] gridExtra_2.3 doParallel_1.0.17 iterators_1.0.14
[4] foreach_1.5.2 funModeling_1.9.5 Hmisc_5.2-1
[7] plotly_4.11.0 ggplot2_3.5.2 DT_0.33
[10] rsample_1.2.1 recipes_1.1.0 dplyr_1.1.4
[13] MachineShop_3.8.0 shinydashboard_0.7.2 shiny_1.10.0
loaded via a namespace (and not attached):
[1] sandwich_3.1-1 rlang_1.1.4 magrittr_2.0.3
[4] multcomp_1.4-26 furrr_0.3.1 compiler_4.4.2
[7] matrixStats_1.4.1 polspline_1.1.25 reshape2_1.4.4
[10] vctrs_0.6.5 stringr_1.5.1 pkgconfig_2.0.3
[13] crayon_1.5.3 fastmap_1.2.0 backports_1.5.0
[16] labeling_0.4.3 pander_0.6.5 promises_1.3.2
[19] rmarkdown_2.29 prodlim_2024.06.25 purrr_1.0.2
[22] xfun_0.49 modeltools_0.2-23 jsonlite_1.8.9
[25] progress_1.2.3 later_1.4.1 prettyunits_1.2.0
[28] cluster_2.1.6 R6_2.5.1 stringi_1.8.4
[31] coin_1.4-3 RColorBrewer_1.1-3 parallelly_1.41.0
[34] rpart_4.1.23 lubridate_1.9.4 Rcpp_1.0.13-1
[37] dials_1.3.0 knitr_1.49 future.apply_1.11.3
[40] zoo_1.8-12 base64enc_0.1-3 httpuv_1.6.15
[43] Matrix_1.7-1 splines_4.4.2 nnet_7.3-19
[46] timechange_0.3.0 tidyselect_1.2.1 yaml_2.3.10
[49] rstudioapi_0.17.1 abind_1.4-8 timeDate_4041.110
[52] codetools_0.2-20 listenv_0.9.1 plyr_1.8.9
[55] lattice_0.22-6 tibble_3.2.1 withr_3.0.2
[58] ROCR_1.0-11 evaluate_1.0.1 moments_0.14.1
[61] foreign_0.8-87 future_1.34.0 survival_3.7-0
[64] kernlab_0.9-33 pillar_1.10.0 party_1.3-17
[67] checkmate_2.3.2 stats4_4.4.2 generics_0.1.3
[70] hms_1.1.3 scales_1.4.0 globals_0.16.3
[73] xtable_1.8-4 class_7.3-22 glue_1.8.0
[76] lazyeval_0.2.2 tools_4.4.2 data.table_1.16.4
[79] gower_1.0.2 mvtnorm_1.3-2 grid_4.4.2
[82] tidyr_1.3.1 libcoin_1.0-10 ipred_0.9-15
[85] colorspace_2.1-1 htmlTable_2.4.3 Formula_1.2-5
[88] cli_3.6.3 DiceDesign_1.10 viridisLite_0.4.2
[91] lava_1.8.0 strucchange_1.5-4 gtable_0.3.6
[94] digest_0.6.37 TH.data_1.1-2 htmlwidgets_1.6.4
[97] farver_2.1.2 entropy_1.3.1 htmltools_0.5.8.1
[100] lifecycle_1.0.4 hardhat_1.4.0 httr_1.4.7
[103] mime_0.12 MASS_7.3-61