1 Overview

This report analyzes biomarker trajectories using state-space modeling. Rather than viewing values as isolated snapshots, we map them onto physiological “landscapes.”

  1. Renal Landscape: Plots BUN against Creatinine to distinguish between intrinsic filtration changes and pre-renal metabolic drift (catabolism or dehydration).
  2. Metabolic Landscape: Plots Triglycerides vs. HDL using Atherogenic Index of Plasma (AIP) to monitor metabolic health.
  3. Metabolic 3D Landscape: A 3D view of Triglycerides, HDL, and Glucose to visualize the “drift” into insulin resistance using the TyG Index.

1.1 Key Features Included:

  • The Flag: At the top of the configuration chunk (just below), you can toggle USE_SAMPLE_DATA <- TRUE/FALSE. When set to FALSE, it will look for your my_lab_results.csv file.
  • Dynamic Age: It calculates your age at the time of each lab test based on your specified birthdate.
  • Physiological Vectoring: The 2D plot uses arrowed paths to show the direction of travel in the renal landscape, making it clear if you are recovering from or drifting into a pre-renal state.
  • AIP & TyG: These derived values are calculated automatically, providing a higher-resolution view of metabolic health than raw Triglyceride or Glucose numbers alone.
# --- USER CONFIGURATION ---
USE_SAMPLE_DATA <- FALSE  # Set to FALSE to use your local 'my_labs.csv'
#USE_SAMPLE_DATA <- TRUE  # Set to FALSE to use your local 'my_labs.csv'
LAB_DATA_FILENAME <- "my_labs.csv"
BIRTHDATE <- as.Date("1965-11-01") #
# --------------------------

2 Data Processing

if (USE_SAMPLE_DATA) {
  # Synthetic data for testing functionality
  lab_data <- data.frame(
    Date = as.Date(c("2024-01-01", "2024-06-01", "2025-01-01", "2025-10-01")),
    BUN = c(14, 21, 28, 18),
    Creatinine = c(0.9, 0.95, 1.3, 1.0),
    Triglycerides = c(70, 90, 140, 85),
    HDL = c(70, 60, 45, 65),
    Glucose = c(85, 92, 105, 88)
  )
} else {
  # Transposing your specific wide-format CSV
  # We skip the first row (Test Description) and use the second (Dates)
  raw <- read.csv(LAB_DATA_FILENAME, skip = 1, header = FALSE, stringsAsFactors = FALSE)
  
  # Transpose: Tests become columns, Dates become rows
  lab_data <- as.data.frame(t(raw[,-1]))
  colnames(lab_data) <- raw[,1]
  colnames(lab_data)[1] <- "Date"
  
  # Clean Date and convert Numeric columns
  lab_data$Date <- mdy(lab_data$Date) 
  lab_data <- lab_data %>%
    mutate(across(-Date, ~as.numeric(as.character(.)))) %>%
    filter(!is.na(Date)) %>%
    arrange(Date)
}
## Warning: There were 2 warnings in `mutate()`.
## The first warning was:
## i In argument: `across(-Date, ~as.numeric(as.character(.)))`.
## Caused by warning:
## ! NAs introduced by coercion
## i Run `dplyr::last_dplyr_warnings()` to see the 1 remaining warning.
# Feature Engineering
lab_data <- lab_data %>%
  mutate(
    Age_at_Test = floor(as.numeric(difftime(Date, BIRTHDATE, units = "weeks")) / 52.25),
    BUN_Cr_Ratio = BUN / Creatinine,
    # TyG Index formula: ln[TG (mg/dL) * Glucose (mg/dL) / 2]
    TyG_Index = log((Triglycerides * Glucose) / 2),
    AIP = log10(Triglycerides / HDL)
  )

Review relevant data.

lab_data %>%
  select(Date, Age_at_Test, BUN, Creatinine, BUN_Cr_Ratio, Triglycerides, HDL, Glucose, TyG_Index, AIP) %>%
  mutate(across(where(is.numeric), \(x) round(x, 2))) %>%
  knitr::kable(row.names = FALSE, caption = "Lab Test Raw Results")
Lab Test Raw Results
Date Age_at_Test BUN Creatinine BUN_Cr_Ratio Triglycerides HDL Glucose TyG_Index AIP
1998-05-12 32 14 1.00 14.00 72 44 90 8.08 0.21
2006-11-21 40 12 0.95 12.63 47 62 92 7.68 -0.12
2007-11-29 42 14 0.90 15.56 72 71 87 8.05 0.01
2008-02-27 42 NA NA NA NA NA NA NA NA
2008-09-15 42 14 0.89 15.73 39 58 83 7.39 -0.17
2009-05-04 43 NA NA NA NA NA NA NA NA
2009-05-18 43 21 0.89 23.60 39 74 76 7.30 -0.28
2009-09-10 43 12 0.89 13.48 45 82 78 7.47 -0.26
2009-12-09 44 16 0.91 17.58 NA NA 80 NA NA
2010-03-17 44 NA NA NA NA NA NA NA NA
2010-07-21 44 16 0.96 16.67 53 79 71 7.54 -0.17
2010-09-02 44 13 0.96 13.54 53 58 70 7.53 -0.04
2010-10-25 44 14 0.92 15.22 60 68 81 7.80 -0.05
2011-02-02 45 16 0.89 17.98 44 66 77 7.43 -0.18
2011-06-28 45 20 0.94 21.28 50 67 78 7.58 -0.13
2011-09-29 45 19 0.94 20.21 58 69 73 7.66 -0.08
2013-04-18 47 13 0.80 16.25 55 75 84 7.75 -0.13
2013-09-27 47 11 0.91 12.09 60 73 78 7.76 -0.09
2016-05-28 50 12 0.84 14.29 44 71 90 7.59 -0.21
2017-07-06 51 14 0.96 14.58 54 75 87 7.76 -0.14
2017-11-17 51 10 0.93 10.75 46 66 88 7.61 -0.16
2018-05-10 52 15 0.86 17.44 51 69 85 7.68 -0.13
2018-11-09 52 16 0.89 17.98 47 79 83 7.58 -0.23
2019-06-05 53 18 0.88 20.45 49 70 78 7.56 -0.15
2020-04-09 54 18 0.85 21.18 50 86 85 7.66 -0.24
2020-09-30 54 15 0.88 17.05 47 60 83 7.58 -0.11
2021-07-23 55 21 0.85 24.71 38 77 77 7.29 -0.31
2022-10-07 56 15 0.83 18.07 47 73 87 7.62 -0.19
2023-08-10 57 18 0.68 26.47 42 74 85 7.49 -0.25
2023-11-29 57 18 0.82 21.95 40 77 86 7.45 -0.28
2024-03-05 58 18 0.84 21.43 45 66 89 7.60 -0.17
2024-06-05 58 16 0.82 19.51 48 70 83 7.60 -0.16
2025-08-06 59 18 0.86 20.93 70 83 80 7.94 -0.07

3 Renal State-Space (BUN/Creatinine)

In this 2D landscape, the dashed lines represent “Iso-Ratio” contours. A trajectory moving vertically (rising BUN faster than Creatinine) indicates a pre-renal state, often linked to dehydration or high protein catabolism. A trajectory moving horizontally indicates intrinsic filtration changes.

# Selective NA removal for Renal Plot
renal_data <- lab_data %>% 
  filter(!is.na(BUN), !is.na(Creatinine), !is.na(BUN_Cr_Ratio))

slopes <- data.frame(m = c(10, 20, 30), label = c("10:1 Normal", "20:1 Pre-renal", "30:1 Catabolic"))

# 1. Prepare the data by defining the coordinates for the end of each arrow
renal_plot_data <- renal_data %>%
  arrange(Date) %>%
  mutate(
    next_Creatinine = lead(Creatinine),
    next_BUN = lead(BUN)
  )

# 2. Plot using geom_segment instead of geom_path
ggplot(renal_plot_data, aes(x = Creatinine, y = BUN, color = BUN_Cr_Ratio)) +
  geom_abline(intercept = 0, slope = slopes$m, linetype = "dashed", color = "grey80") +
  # Use geom_segment to get arrows on every leg of the journey
  geom_segment(aes(xend = next_Creatinine, yend = next_BUN),
               arrow = arrow(length = unit(0.3, "cm"), type = "closed"), 
               color = "grey80", linewidth = 1, alpha = 0.7) +
  geom_point(size = 4) +
  geom_text(aes(label = format(Date, "%y-%m")), vjust = -1.2, size = 3) +
  scale_color_viridis_c(option = "plasma", name = "BUN/Cr Ratio") +
  labs(title = "Renal Trajectory: Filtration vs. Metabolism",
       subtitle = "Arrows indicate direction of time; labels show YY-MM",
       x = "Creatinine (mg/dL) - Filtration Capacity",
       y = "BUN (mg/dL) - Protein/Metabolic Load") +
  theme_minimal()
## Warning: Removed 1 row containing missing values or values outside the scale range
## (`geom_segment()`).

# Selective NA removal for Renal Plot
renal_data <- lab_data %>% 
  filter(!is.na(BUN), !is.na(Creatinine), !is.na(BUN_Cr_Ratio))

slopes <- data.frame(m = c(10, 20, 30), label = c("10:1 Normal", "20:1 Pre-renal", "30:1 Catabolic"))

# 1. Dynamic Year Calculation
year_range <- range(year(renal_data$Date), na.rm = TRUE)
dynamic_title <- paste0("Renal Trajectory: Filtration vs. Metabolism ", 
                        year_range[1], "–", year_range[2])

# 2. Prepare the segment data (arrows)
renal_segments <- renal_data %>%
  arrange(Date) %>%
  mutate(xend = lead(Creatinine), yend = lead(BUN)) %>%
  filter(!is.na(xend))

# 3. Create the arrow annotations
# This replaces geom_segment and survives the interactive conversion
arrow_list <- lapply(1:nrow(renal_segments), function(i) {
  list(
    x = renal_segments$xend[i],
    y = renal_segments$yend[i],
    ax = renal_segments$Creatinine[i],
    ay = renal_segments$BUN[i],
    xref = "x", yref = "y", axref = "x", ayref = "y",
    showarrow = TRUE,
    arrowhead = 2,      # Professional closed arrow
    arrowsize = 1,
    arrowwidth = 1.5,
    arrowcolor = "rgba(200, 200, 200, 0.6)", # Grey80 with transparency
    standoff = 6        # Keeps arrow from overlapping the center of the dot
  )
})

# 4. Build the Interactive Plot
plot_ly(renal_data) %>%
  # The Markers & Labels
  add_trace(
    x = ~Creatinine, y = ~BUN,
    type = 'scatter', mode = 'markers+text',
    color = ~BUN_Cr_Ratio, colorscale = 'Plasma',
    text = ~format(Date, "%y-%m"),
    textposition = "top center", # Replaces your 'nudge' logic
    marker = list(size = 10),
    hoverinfo = 'text',
    hovertext = ~paste0("<b>Date: ", format(Date, "%Y-%m-%d"), "</b><br>",
                       "BUN: ", BUN, " | Cr: ", Creatinine, "<br>",
                       "Ratio: ", round(BUN_Cr_Ratio, 2), "<br>",
                       "Glucose: ", Glucose)
  ) %>%
  layout(
    title = list(text = dynamic_title, x = 0, y = 0.98),
    xaxis = list(title = "Creatinine (mg/dL) - Filtration Capacity"),
    yaxis = list(title = "BUN (mg/dL) - Protein/Metabolic Load"),
    annotations = arrow_list, # Adds the arrows back
    showlegend = FALSE,
    margin = list(t = 100)
  ) %>%
  # Add the subtitle as a paper-anchored annotation
  add_annotations(
    text = "Arrows indicate direction of time; labels show YY-MM; Hover points for full lab values",
    xref = "paper", yref = "paper", x = 0, y = 1.08, 
    showarrow = FALSE, font = list(size = 12, color = "grey40")
  )
## Warning: textfont.color doesn't (yet) support data arrays
## Warning: textfont.color doesn't (yet) support data arrays
## Warning: 'scatter' objects don't have these attributes: 'colorscale'
## Valid attributes include:
## 'alignmentgroup', 'cliponaxis', 'connectgaps', 'customdata', 'customdatasrc', 'dx', 'dy', 'error_x', 'error_y', 'fill', 'fillcolor', 'fillpattern', 'groupnorm', 'hoverinfo', 'hoverinfosrc', 'hoverlabel', 'hoveron', 'hovertemplate', 'hovertemplatesrc', 'hovertext', 'hovertextsrc', 'ids', 'idssrc', 'legend', 'legendgroup', 'legendgrouptitle', 'legendrank', 'legendwidth', 'line', 'marker', 'meta', 'metasrc', 'mode', 'name', 'offsetgroup', 'opacity', 'orientation', 'selected', 'selectedpoints', 'showlegend', 'stackgaps', 'stackgroup', 'stream', 'text', 'textfont', 'textposition', 'textpositionsrc', 'textsrc', 'texttemplate', 'texttemplatesrc', 'transforms', 'type', 'uid', 'uirevision', 'unselected', 'visible', 'x', 'x0', 'xaxis', 'xcalendar', 'xhoverformat', 'xperiod', 'xperiod0', 'xperiodalignment', 'xsrc', 'y', 'y0', 'yaxis', 'ycalendar', 'yhoverformat', 'yperiod', 'yperiod0', 'yperiodalignment', 'ysrc', 'key', 'set', 'frame', 'transforms', '_isNestedKey', '_isSimpleKey', '_isGraticule', '_bbox'

3.1 Interactive Renal Dashboard with Collision Tracking

# Selective NA removal for Renal Plot
renal_data <- lab_data %>% 
  filter(!is.na(BUN), !is.na(Creatinine), !is.na(BUN_Cr_Ratio))

slopes <- data.frame(m = c(10, 20, 30), label = c("10:1 Normal", "20:1 Pre-renal", "30:1 Catabolic"))

# 1. Identify Overlaps (Exact Collisions)
# We flag points that share the same Creatinine and BUN values
renal_data_prepped <- renal_data %>%
  arrange(Date) %>%
  group_by(Creatinine, BUN) %>%
  mutate(
    Collision_Group = ifelse(n() > 1, paste(format(Date, "%y-%m"), collapse = ", "), "Unique"),
    Is_Collision = n() > 1
  ) %>%
  ungroup() %>%
  mutate(
    # Lead values for segments
    next_Cr = lead(Creatinine),
    next_BUN = lead(BUN)
  )

# 2. Create the Shared Data Object
# This is the "bridge" that allows the slider to talk to the plot AND the table
shared_renal <- SharedData$new(renal_data_prepped, key = ~Date)

# 3. Dynamic Title
year_range <- range(year(renal_data$Date), na.rm = TRUE)
dynamic_title <- paste0("Renal Trajectory: Filtration vs. Metabolism ", year_range[1], "–", year_range[2])

# 4. Build the Plotly Component
p <- plot_ly(shared_renal) %>%
  # The Markers & Labels
  add_trace(
    x = ~Creatinine, y = ~BUN,
    type = 'scatter', mode = 'markers+text',
    color = ~BUN_Cr_Ratio, colorscale = 'Plasma',
    text = ~format(Date, "%y-%m"),
    textposition = "top center",
    marker = list(size = 10, opacity = 0.8),
    hoverinfo = 'text',
    hovertext = ~paste0("<b>Date: ", format(Date, "%Y-%m-%d"), "</b><br>",
                       "BUN: ", BUN, " | Cr: ", Creatinine, "<br>",
                       "Ratio: ", round(BUN_Cr_Ratio, 2), "<br>",
                       "Collisions: ", Collision_Group)
  ) %>%
  layout(
    title = list(text = dynamic_title, x = 0),
    xaxis = list(title = "Creatinine (mg/dL) - Filtration Capacity"),
    yaxis = list(title = "BUN (mg/dL) - Protein/Metabolic Load"),
    showlegend = FALSE,
    margin = list(t = 100)
  )

# 5. Build the Collision Report (Table)
# This table will filter automatically when you move the date slider
collision_table <- datatable(
  shared_renal,
  colnames = c("Date", "Creatinine", "BUN", "BUN/Cr Ratio", "Shared Coordinates With"),
  options = list(pageLength = 5, dom = 'tp'), # 'tp' shows only table and pagination
  selection = "none",
  class = 'display compact'
) %>%
  formatRound(columns = c('Creatinine', 'BUN', 'BUN_Cr_Ratio'), digits = 2)

# 6. Assemble the Dashboard
# This puts the slider on top, the plot in the middle, and the table at the bottom
bscols(
  widths = c(12),
  filter_slider("date_filter", "Select Date Range to De-clutter", shared_renal, ~Date, width = "100%"),
  p,
  tags$h4("Collision Report (Filtered by Slider)"),
  collision_table
)
## Warning in bscols(widths = c(12), filter_slider("date_filter", "Select Date
## Range to De-clutter", : Sum of bscol width units is greater than 12
## Warning: textfont.color doesn't (yet) support data arrays
## Warning: textfont.color doesn't (yet) support data arrays
## Warning: 'scatter' objects don't have these attributes: 'colorscale'
## Valid attributes include:
## 'alignmentgroup', 'cliponaxis', 'connectgaps', 'customdata', 'customdatasrc', 'dx', 'dy', 'error_x', 'error_y', 'fill', 'fillcolor', 'fillpattern', 'groupnorm', 'hoverinfo', 'hoverinfosrc', 'hoverlabel', 'hoveron', 'hovertemplate', 'hovertemplatesrc', 'hovertext', 'hovertextsrc', 'ids', 'idssrc', 'legend', 'legendgroup', 'legendgrouptitle', 'legendrank', 'legendwidth', 'line', 'marker', 'meta', 'metasrc', 'mode', 'name', 'offsetgroup', 'opacity', 'orientation', 'selected', 'selectedpoints', 'showlegend', 'stackgaps', 'stackgroup', 'stream', 'text', 'textfont', 'textposition', 'textpositionsrc', 'textsrc', 'texttemplate', 'texttemplatesrc', 'transforms', 'type', 'uid', 'uirevision', 'unselected', 'visible', 'x', 'x0', 'xaxis', 'xcalendar', 'xhoverformat', 'xperiod', 'xperiod0', 'xperiodalignment', 'xsrc', 'y', 'y0', 'yaxis', 'ycalendar', 'yhoverformat', 'yperiod', 'yperiod0', 'yperiodalignment', 'ysrc', 'key', 'set', 'frame', 'transforms', '_isNestedKey', '_isSimpleKey', '_isGraticule', '_bbox'

Collision Report (Filtered by Slider)

4 Metabolic Lipid Trajectory (TG/HDL)

This 2D trajectory focuses on the Atherogenic Index of Plasma (AIP). Movement toward the bottom-right indicates improved metabolic health.

# Selective NA removal for Metabolic Plot
metabolic_2d <- lab_data %>% 
  filter(!is.na(Triglycerides), !is.na(HDL), !is.na(AIP))

# 1. Prepare the data by defining the coordinates for the end of each arrow
metabolic_plot_data <- metabolic_2d %>%
  arrange(Date) %>%
  mutate(
    next_HDL = lead(HDL),
    next_Triglycerides = lead(Triglycerides)
  )

# 2. Plot using geom_segment for per-segment arrows
ggplot(metabolic_plot_data, aes(x = HDL, y = Triglycerides, color = AIP)) +
  # Use geom_segment to ensure every time-step has an arrow head
  geom_segment(aes(xend = next_HDL, yend = next_Triglycerides),
               arrow = arrow(length = unit(0.3, "cm"), type = "closed"), 
               color = "grey80", linewidth = 1, alpha = 0.7) +
  geom_point(size = 4) +
  geom_text(aes(label = format(Date, "%y-%m")), vjust = -1.2, size = 3) +
  scale_color_viridis_c(option = "viridis", name = "AIP (log10 TG/HDL)") +
  labs(title = "Metabolic Trajectory: TG/HDL Ratio",
       subtitle = "Movement toward high HDL and low TG indicates metabolic efficiency",
       x = "HDL (mg/dL) - Protective Buffer",
       y = "Triglycerides (mg/dL) - Fuel Flow") +
  theme_minimal()
## Warning: Removed 1 row containing missing values or values outside the scale range
## (`geom_segment()`).

5 Metabolic 3D Landscape

This interactive plot displays the relationship between fuel pressure (Glucose), fuel flow (Triglycerides), and your protective buffer (HDL).

No arrowheads indicating direction here. They were more trouble than they are worth in plotly.

# Filter for 3D plot
m3d_data <- lab_data %>% 
  filter(!is.na(HDL), !is.na(Triglycerides), !is.na(Glucose))

plot_ly(m3d_data, x = ~HDL, y = ~Triglycerides, z = ~Glucose, 
        type = 'scatter3d', mode = 'lines+markers+text',
        line = list(width = 6, color = ~TyG_Index, colorscale = 'Viridis'),
        marker = list(size = 5, color = ~TyG_Index, colorscale = 'Viridis', showscale = TRUE, colorbar = list(title = "TyG Index")),
        text = ~paste(format(Date, "%y-%m")),
        textposition = "top center",
        hoverinfo = 'text+x+y+z') %>%
  layout(title = "3D Metabolic Evolution (Color = TyG Index)",
         scene = list(
           xaxis = list(title = "HDL"),
           yaxis = list(title = "Triglycerides"),
           zaxis = list(title = "Glucose")
         ))

6 Standard Interpretation Guidelines

These markers reflect standard clinical reference ranges used by most diagnostic labs.

Variable Standard Range Clinical Significance
Glucose 65 – 99 mg/dL Fasting fuel pressure.
BUN 6 – 24 mg/dL Urea nitrogen; reflects protein breakdown and renal clearance.
Creatinine 0.70 – 1.30 mg/dL Direct marker of kidney filtration capacity.
Triglycerides < 150 mg/dL Circulating fat; marker of fuel “spillover.”
HDL > 40 mg/dL Protective lipid fraction.
BUN/Cr Ratio 10:1 – 20:1 Distinguishes between dehydration (high) and kidney issues (low).

7 Functional Medicine Guidelines (Dicken Weatherby)

Dicken Weatherby’s “Functional Blood Chemistry Analysis” focuses on narrower, tighter ranges to identify physiological drift before clinical disease occurs.

Variable Functional Range Weatherby Interpretation
Glucose 75 – 86 mg/dL Optimal glycemic control; avoids “glycemic variability.”
BUN 10 – 16 mg/dL Optimal protein metabolism; values >16 may suggest dehydration.
Creatinine 0.8 – 1.1 mg/dL Ideal filtration; values <0.8 may suggest low muscle mass.
Triglycerides 70 – 100 mg/dL Optimal fuel flow; values <70 often seen in very low-carb cohorts.
HDL 55 – 70 mg/dL Ideal protective buffer; >70 is excellent.
BUN/Cr Ratio 12:1 – 16:1 The “Sweet Spot” for hydration and protein balance.
AIP < 0.11 Low risk for atherogenic dyslipidemia.
TyG Index < 4.49 Optimal insulin sensitivity.

7.1 Analysis Notes for Richard

  • Renal Drift: Your 2021-07 data point (BUN 21, Creatinine 0.85) showed a ratio of 24.71. Under Weatherby’s guidelines, this is a clear “Pre-renal/Dehydration” signal, as the BUN escaped the 10–16 optimal range while Creatinine stayed stable.

  • Metabolic Efficiency: Given your grain-free status since ~2008, your Triglyceride/HDL ratio (AIP) is a high-resolution metric for your insulin sensitivity. Most of your recent values remain well within the “Functional” optimal zone.

8 2D Ca-P Mineralization Trajectory

This plot tracks the Calcium-Phosphorus product and ratio over time.

8.1 Strategic Insights from these Visuals

  • The Isoclines: In the 2D plot, the curved dotted lines represent the product Ca * P = K. If your points begin migrating toward the top-right (approaching the 55 isocline), it indicates a high risk of vascular calcification regardless of whether individual Ca or P levels look “normal.”
  • The ALP Dimension: Adding ALP in 3D helps identify if a spike in Calcium or Phosphorus is due to low turnover (low ALP, minerals “stagnating” in blood) or high turnover/remodeling (high ALP, minerals being actively mobilized).
  • Ratio vs. Product: The dashed diagonal lines represent the Ca:P ratio. A balanced trajectory typically follows the \(1.2:1\) to \(1.5:1\) slopes. Deviations toward the Phosphorus (Y) axis suggest a shift toward metabolic acidity or hyperphosphatemia.
# 0. Fix spelling (res)
lab_data$Phosphorus <- lab_data$Phosphorous

# 1. Prepare Data with Usable Product Logic
cap_data <- lab_data %>%
  filter(!is.na(Calcium), !is.na(Phosphorus)) %>%
  arrange(Date) %>%
  mutate(
    Ratio = Calcium / Phosphorus,
    # Excel Logic: IF(Ratio > 2.5, P*P*2.5, Ca*Ca/2.5)
    Usable_Product = if_else(Ratio > 2.5, Phosphorus^2 * 2.5, Calcium^2 / 2.5),
    next_Ca = lead(Calcium),
    next_P = lead(Phosphorus)
  )

# 2. Define Isoclines (L-shaped Bottleneck lines)
isocline_levels <- c(30, 40, 50, 55)
isocline_df <- do.call(rbind, lapply(isocline_levels, function(C) {
  corner_p <- sqrt(C / 2.5)
  corner_ca <- corner_p * 2.5
  data.frame(
    Calcium = c(corner_ca, corner_ca, max(cap_data$Calcium) + 2),
    Phosphorus = c(max(cap_data$Phosphorus) + 2, corner_p, corner_p),
    Val = C
  )
}))

# 3. Build Static Plot
p_2d <- ggplot(cap_data, aes(x = Calcium, y = Phosphorus)) +
  # Isoclines
  geom_path(data = isocline_df, aes(group = Val), color = "grey90", linetype = "dotted") +
  geom_text(data = data.frame(v = isocline_levels), 
            aes(x = sqrt(v/2.5)*2.5, y = sqrt(v/2.5), label = paste0("UP:", v)),
            nudge_x = 0.1, nudge_y = 0.03, size = 2.5, color = "grey70") +
  # Ratio Grids
  geom_abline(intercept = 0, slope = 1/c(1, 1.5, 2, 2.5), color = "grey95", linetype = "dashed") +
  annotate("text", x = max(cap_data$Calcium), y = max(cap_data$Calcium)/c(1, 1.5, 2, 2.5), 
           label = c("1:1", "1.5:1", "2:1", "2.5:1"), size = 2, color = "grey80", hjust = 1) +
  
  # Trajectory Path
  geom_segment(aes(xend = next_Ca, yend = next_P), color = "grey80", alpha = 0.6) +
  
  # Adjusted Labels: nudge_y reduced to 0.05 for tighter alignment
  geom_text(aes(label = format(Date, "%y-%m")), nudge_y = 0.05, size = 2.5, color = "grey30") +
  
  # Markers
  geom_point(aes(color = Usable_Product,
                 label = paste0("<b>Date: ", format(Date, "%Y-%m"), "</b><br>",
                                "Usable Product: ", round(Usable_Product, 1), "<br>",
                                "Ca/P Ratio: ", round(Ratio, 2))), size = 4) +
  
  scale_color_viridis_c(option = "plasma", name = "Usable Product") +
  coord_cartesian(xlim = range(cap_data$Calcium) + c(-0.2, 0.2),
                  ylim = range(cap_data$Phosphorus) + c(-0.2, 0.2)) +
  labs(title = paste0("Ca-P Trajectory: Usable Mineralization Product ", 
                      min(year(cap_data$Date)), "–", max(year(cap_data$Date))),
       subtitle = "L-shaped isoclines indicate mineralization bottleneck; Labels show YY-MM",
       x = "Calcium (mg/dL)", y = "Phosphorus (mg/dL)") +
  theme_minimal()
## Warning in geom_point(aes(color = Usable_Product, label = paste0("<b>Date: ", :
## Ignoring unknown aesthetics: label
# 4. Interactive Conversion & Arrow Stitching
gg_p <- ggplotly(p_2d, tooltip = "label")
segments <- cap_data %>% filter(!is.na(next_Ca))
arrows <- lapply(1:nrow(segments), function(i) {
  list(x = segments$next_Ca[i], y = segments$next_P[i],
       ax = segments$Calcium[i], ay = segments$Phosphorus[i],
       xref = "x", yref = "y", axref = "x", ayref = "y",
       showarrow = TRUE, arrowhead = 2, arrowsize = 0.8, arrowwidth = 1, 
       arrowcolor = "rgba(200, 200, 200, 0.6)")
})
gg_p %>% layout(annotations = arrows)

9 3D Ca-P-ALP Trajectory

This adds the “Mineralization Engine” (ALP) as the Z-axis to show how bone turnover velocity correlates with mineral availability.

# 0. Fix spelling (res)
lab_data$Phosphorus <- lab_data$Phosphorous
lab_data$ALP <- lab_data[, "Alk Phos"]

# 1. Prepare Data with Usable Product Logic
cap_3d_data <- lab_data %>%
  filter(!is.na(Calcium), !is.na(Phosphorus), !is.na(ALP)) %>%
  arrange(Date) %>%
  mutate(
    Ratio = Calcium / Phosphorus,
    # Excel Formula Logic
    Usable_Product = if_else(Ratio > 2.5, Phosphorus^2 * 2.5, Calcium^2 / 2.5),
    # Calculate direction vectors for 3D arrowheads (cones)
    u = lead(Calcium) - Calcium,
    v = lead(Phosphorus) - Phosphorus,
    w = lead(ALP) - ALP,
    next_UP = lead(Usable_Product)
  )

# 2. Build 3D Plotly
plot_ly(cap_3d_data) %>%
  # The Markers & Labels
  add_trace(
    x = ~Calcium, y = ~Phosphorus, z = ~ALP,
    type = 'scatter3d', mode = 'markers+text',
    marker = list(size = 5, color = ~Usable_Product, 
                  colorscale = 'Plasma', showscale = TRUE,
                  colorbar = list(title = "Usable Product")),
    text = ~format(Date, "%y-%m"),
    textposition = "top center",
    hoverinfo = 'text',
    hovertext = ~paste0("<b>Date: ", format(Date, "%Y-%m-%d"), "</b><br>",
                       "Usable Product: ", round(Usable_Product, 1), "<br>",
                       "Ca/P Ratio: ", round(Ratio, 2), "<br>",
                       "ALP: ", ALP)
  ) %>%
  # The Path (Line)
  add_trace(
    x = ~Calcium, y = ~Phosphorus, z = ~ALP,
    type = 'scatter3d', mode = 'lines',
    line = list(width = 4, color = "grey80"),
    hoverinfo = "none"
  ) %>%
  # The Arrowheads (Cones) - Anchored at the "tip" (destination)
  add_trace(
    type = "cone",
    x = ~lead(Calcium), y = ~lead(Phosphorus), z = ~lead(ALP),
    u = ~u, v = ~v, w = ~w,
    color = ~next_UP, colorscale = 'Plasma', # Match color to destination
    sizemode = 'absolute', sizeref = 0.5, 
    showscale = FALSE, anchor = 'tip', hoverinfo = "none"
  ) %>%
  layout(
    title = "3D Mineralization Trajectory (Color = Usable Product)",
    scene = list(
      xaxis = list(title = "Calcium"),
      yaxis = list(title = "Phosphorus"),
      zaxis = list(title = "ALP (Bone Turnover)")
    )
  )
## Warning: Ignoring 1 observations
## Warning: 'cone' objects don't have these attributes: 'marker'
## Valid attributes include:
## 'anchor', 'autocolorscale', 'cauto', 'cmax', 'cmid', 'cmin', 'coloraxis', 'colorbar', 'colorscale', 'customdata', 'customdatasrc', 'hoverinfo', 'hoverinfosrc', 'hoverlabel', 'hovertemplate', 'hovertemplatesrc', 'hovertext', 'hovertextsrc', 'ids', 'idssrc', 'legend', 'legendgroup', 'legendgrouptitle', 'legendrank', 'legendwidth', 'lighting', 'lightposition', 'meta', 'metasrc', 'name', 'opacity', 'reversescale', 'scene', 'showlegend', 'showscale', 'sizemode', 'sizeref', 'stream', 'text', 'textsrc', 'type', 'u', 'uhoverformat', 'uid', 'uirevision', 'usrc', 'v', 'vhoverformat', 'visible', 'vsrc', 'w', 'whoverformat', 'wsrc', 'x', 'xhoverformat', 'xsrc', 'y', 'yhoverformat', 'ysrc', 'z', 'zhoverformat', 'zsrc', 'key', 'set', 'frame', 'transforms', '_isNestedKey', '_isSimpleKey', '_isGraticule', '_bbox'
# 1. Process table data
mineralization_table <- lab_data %>%
  filter(!is.na(Calcium), !is.na(Phosphorus), !is.na(ALP)) %>%
  arrange(Date) %>%
  mutate(
    Ratio = round(Calcium / Phosphorus, 2),
    # Calculate Usable Product per Excel logic
    Usable_Product = round(if_else(Ratio > 2.5, Phosphorus^2 * 2.5, Calcium^2 / 2.5), 1)
  ) %>%
  select(Date, Calcium, Phosphorus, ALP, Ratio, Usable_Product)

# 2. Output table using kable
kable(mineralization_table, 
      row.names = FALSE,
      caption = "Comprehensive Mineralization Metrics: 1998–2025",
      col.names = c("Date", "Ca (mg/dL)", "P (mg/dL)", "ALP (U/L)", "Ca:P Ratio", "Usable Product"),
      align = "c")
Comprehensive Mineralization Metrics: 1998–2025
Date Ca (mg/dL) P (mg/dL) ALP (U/L) Ca:P Ratio Usable Product
1998-05-12 9.6 2.7 48 3.56 18.2
2009-12-09 9.3 3.1 45 3.00 24.0
2010-07-21 9.2 3.0 45 3.07 22.5
2010-09-02 9.1 3.5 46 2.60 30.6
2010-10-25 10.0 3.3 49 3.03 27.2
2011-02-02 9.4 3.2 43 2.94 25.6
2011-06-28 9.9 3.4 52 2.91 28.9
2011-09-29 9.4 3.3 46 2.85 27.2
2013-04-18 9.6 3.8 51 2.53 36.1
2013-09-27 9.9 3.1 46 3.19 24.0
2016-05-28 9.6 3.1 39 3.10 24.0
2017-07-06 9.4 3.0 37 3.13 22.5
2017-11-17 9.6 2.8 43 3.43 19.6
2018-05-10 9.7 2.9 42 3.34 21.0
2018-11-09 9.5 3.3 43 2.88 27.2
2019-06-05 9.3 3.0 44 3.10 22.5
2020-04-09 9.2 2.8 45 3.29 19.6
2020-09-30 9.5 3.3 53 2.88 27.2
2021-07-23 9.8 3.1 51 3.16 24.0
2022-10-07 9.5 3.0 49 3.17 22.5
2023-08-10 9.6 3.0 42 3.20 22.5
2023-11-29 9.3 2.8 44 3.32 19.6
2024-03-05 9.7 3.4 46 2.85 28.9
2024-06-05 9.6 2.7 44 3.56 18.2
2025-08-06 9.6 3.2 49 3.00 25.6

10 Ideas for Pairs of Variables

Applying a state-space or phase-plot approach to biomarker pairs allows you to visualize “metabolic drift” and “landscape” transitions that are invisible in standard time-series data. Based on your existing work with Revici’s potassium and Melvin Page’s calcium and phosphorus balance, several other biomarker pairs are well-suited for this type of geometric analysis.

10.1 Calcium and Phosphorus (The Melvin Page Axis)

Your work in this area already establishes a powerful framework for this approach. Melvin Page identified that a blood ratio of 10:4 (2.5:1) Calcium to Phosphorus was the “goldilocks zone” where dental resorption and bone loss ceased.

  • The Landscape: You can map this by plotting Serum Calcium (y) against Serum Phosphorus (x). The “landscape” is defined by Iso-Ratio lines (e.g., the 2.5:1 line) and Iso-Product curves (Ca x P product).

  • The Trajectory: Movement toward the upper left (high Ca, low P) suggests a “Sympathetic Dominance” state where the body may be sacrificing bone tissue to preserve serum levels, often driven by refined carbohydrates. Movement toward the lower right suggests “Parasympathetic Dominance”.

  • Novelty: Integrating this with the FGF23-Klotho axis and Alkaline Phosphatase (ALP) creates a 3D landscape where ALP acts as the “gatekeeper” of the mineralization environment.

10.2 Copper and Zinc (The Walsh/Pfeiffer Landscape)

This pair is a primary focus of DHA Labs and is central to identifying biochemical “biotypes” for mental health.

  • The Landscape: Plotting Serum Copper vs. Plasma Zinc. The “safe zone” is defined by specific ratios (often ~1:1) and, crucially, by the Percentage of Free Copper (copper not bound to ceruloplasmin).

  • The Trajectory: A trajectory moving into the “High Copper/Low Zinc” quadrant is a hallmark of oxidative stress and is frequently linked to ADHD, anxiety, and postpartum depression. This maps perfectly onto your interest in “Software” (neurochemistry) interacting with “Hardware” (mineral balance).

10.3 SAM and SAH (The Methylation Index)

As seen in your analysis of Genova Diagnostics’ Methylation Panel, the ratio of S-adenosylmethionine (SAM) to S-adenosylhomocysteine (SAH) is the definitive measure of methylation capacity.

  • The Landscape: Plotting SAM vs. SAH creates a “Methylation Index” landscape.
  • The Trajectory: You can visualize “The Clog” (Quadrant 2 in your Folate Confusion Matrix) where high homocysteine exists despite seemingly “sufficient” folate. A trajectory moving away from the healthy SAM/SAH ratio indicates a systemic failure in the methionine cycle, which you’ve noted is “almost comically broken” in your own architecture.

10.4 T3 and Reverse T3 (The Metabolic Throttle)

This pair tracks the efficiency of thyroid hormone conversion, which is highly sensitive to systemic stress and nutrient status.

  • The Landscape: Plotting Free T3 against Reverse T3.
  • The Trajectory: In states of “ATP Brownout” or systemic inflammation, the body shifts the trajectory toward Reverse T3 (the metabolic brake) to conserve energy. This is the endocrine version of your K-ATP Channel Trigger, where the system sacrifices “liveliness” to prevent metabolic bankruptcy.

10.5 Triglycerides and HDL (The Insulin Sensitivity Proxy)

This ratio is one of the strongest objective biomarkers for metabolic health and the “exposome”.

  • The Landscape: Plotting Triglycerides vs. HDL.
  • The Trajectory: A trajectory moving toward high triglycerides and low HDL is a sensitive integrator of dietary and chemical exposures, marking the shift toward insulin resistance long before fasting glucose may fail.

10.6 Lactate and Pyruvate (The Mitochondrial Efficiency Map)

Given your focus on ATP production and Lactate Bypass for neurogenesis, this pair is highly relevant.

  • The Landscape: The ratio of Lactate to Pyruvate (L:P) indicates the redox state (NADH/NAD+) of the cytosol.
  • The Trajectory: A shift toward high lactate relative to pyruvate maps the transition from aerobic to anaerobic metabolism, a “Phase Shift” that signals mitochondrial distress or oxygen deprivation.

10.7 Summary of Future Phase-Plot Candidates

Biomarker Pair Landscape Feature Clinical Relevance
BUN / Creatinine Hydration/Renal Landscape Distinguishing pre-renal vs. intrinsic kidney issues.
Cortisol / DHEA-S Stress Resilience Hub HPA axis balance and adrenal “exhaustion” trajectories.
Anion Gap / SID Acid-Base Topology Mapping complex metabolic acidosis states.

11 File History

File Initially created: Saturday, April 11, 2026

File knitted: Sat Apr 11 20:55:25 2026

12 Bibliography