Gestational age calculator

With the goal of transitioning away from PHP-based web tools, I’ve started writing functions to improve user interface and experience when working with newborn gestational ages.

Goal: given input of any set of LMP, EDC, DOB, date, GA, age, DOL, PMA, calculate as many of the others as possible. Returns NULL if there is a conflict in the input data.

• lmp: date last menstrual period
• edc: due date
• dob: date of birth
• date: date of interest
• ga: GA in ## #/7 format
• age: age in days (zero on the day of birth)
• dol: day of life (one on the day of birth)
• pma: PMA in ## #/7 format

Previously released tools that perform these calculations include:

• PediTools web tool, written in PHP
• iOS app, written in Swift

Previously described code to parse gestational ages

• extract_weeks(ga_string)
• extract_days(ga_string)
• weeks_to_days(ga_string)
• days_to_weeks(days)

library(dplyr)
library(stringr)

extract_weeks <- function(ga_string) {
  as.integer(str_extract(ga_string, "\\d+"))  # First consecutive string of digits
}
extract_days <- function(ga_string) {
  # imperfect logic: 18/7 will return 8
  days <- str_extract(ga_string, "\\d(?=(/7|d))") # Extract single digit before "/7" or "d"
  days[is.na(days)] <- "0"
  as.integer(days)
}
weeks_to_days <- function(ga_string) {
  # cleaned string: paste0(extract_weeks(ga_string), " ", extract_days(ga_string), "/7")
  as.integer(extract_weeks(ga_string)*7 + extract_days(ga_string))
}
days_to_weeks <- function(days) {
  # Convert days to weeks as string in ## #/7 format
  weeks <- floor(days / 7)
  days <- days %% 7
  result <- ifelse(is.na(weeks), NA, paste0(weeks, " ", days, "/7"))
  return(result)
}

Code for gestational age calculations

• ga_calc(lmp, edc, dob, date, ga, age, dol, pma)

The logic is really brute force and not very elegant.

Basically, every possible relationship is described. Starting with the given inputs, keep looping around and try to calculate another output field, and repeat until either nothing more can be calculated, or a conflict is detected representing a contradictory set of inputs.

It’s ugly, but it works.

For a generalizable solution, another option might be to convert the equalities into error terms and try to use some sort of gradient descent to settle on close approximation of solutions (assuming there are no local minima). You’d have to deal with inadequate inputs resulting in some terms that can not be calculated – avoiding including those in the gradient descents. It seems not worth the effort when there are a pretty limited number of fields.

Interestingly, way back in the 1990’s, there was a Palm Pilot application called Mathpad which functioned as a general equation solver. I’ve always wondered how it worked. Still do.

ga_calc <- function(lmp = NA, edc = NA, dob = NA, date = NA, ga = NA, age = NA, dol = NA, pma = NA) {
  # Given available inputs, provide all outputs that can be calculated
  # - returns NULL if there is a conflict
  #
  # lmp  # date last menstrual period
  # edc  # due date
  # dob  # date of birth
  # date # date of interest
  # ga   # GA in ## #/7 format
  # age  # age in days (zero on the day of birth)
  # dol  # day of life (one on the day of birth)
  # pma  # PMA in ## #/7 format

  ga <- days_to_weeks(weeks_to_days(ga))   # normalize input dates to ## #/7
  pma <- days_to_weeks(weeks_to_days(pma))
  lmp <- as.Date(lmp)
  edc <- as.Date(edc)
  dob <- as.Date(dob)
  date <- as.Date(date)

  repeat {
    no_changes <- TRUE # will keep on looping through calculations until nothing has been changed
    data_conflict <- FALSE # set this to TRUE if the submitted data is self-contradictory
    ########## If know EDC, calculate LMP
    if (!is.na(edc)) {
      lmp_calc <- edc - 40*7
      if (!is.na(lmp)) {
        if (lmp_calc != lmp) {
          data_conflict <- TRUE
        }
      } else {
        lmp <- lmp_calc
        no_changes <- FALSE
      }
    }
    ########## If know LMP, calculate EDC
    if (!is.na(lmp)) {
      edc_calc <- lmp + 40*7
      if (!is.na(edc)) {
        if (edc_calc != edc) {
          data_conflict <- TRUE
        }
      } else {
        edc <- edc_calc
        no_changes <- FALSE
      }
    }
    ########## If know DOL, calculate age
    if (!is.na(dol)) {
      age_calc <- dol - 1
      if (!is.na(age)) {
        if (age_calc != age) {
          data_conflict <- TRUE
        }
      } else {
        age <- age_calc
        no_changes <- FALSE
      }
    }
    ########## If know age, calculate DOL
    if (!is.na(age)) {
      dol_calc <- age + 1
      if (!is.na(dol)) {
        if (dol_calc != dol) {
          data_conflict <- TRUE
        }
      } else {
        dol <- dol_calc
        no_changes <- FALSE
      }
    }
    ########## If know DOB and LMP, calculate GA
    if ( (!is.na(dob)) && (!is.na(lmp)) ) {
      ga_calc <- days_to_weeks(as.integer(dob - lmp))
      if (!is.na(ga)) {
        if (ga_calc != ga) {
          data_conflict <- TRUE
        }
      } else {
        ga <- ga_calc
        no_changes <- FALSE
      }
    }
    ########## If know GA and LMP, calculate DOB
    if ( (!is.na(ga)) && (!is.na(lmp)) ) {
      dob_calc <- weeks_to_days(ga) + lmp
      if (!is.na(dob)) {
        if (dob_calc != dob) {
          data_conflict <- TRUE
        }
      } else {
        dob <- dob_calc
        no_changes <- FALSE
      }
    }
    ########## If know DOB and GA, calculate LMP
    if ( (!is.na(dob)) && (!is.na(ga)) ) {
      lmp_calc <- dob - weeks_to_days(ga)
      if (!is.na(lmp)) {
        if (lmp_calc != lmp) {
          data_conflict <- TRUE
        }
      } else {
        lmp <- lmp_calc
        no_changes <- FALSE
      }
    }
    ########## If know date and DOB, calculate age
    if ( (!is.na(date)) && (!is.na(dob)) ) {
      age_calc <- as.integer(date - dob)
      if (!is.na(age)) {
        if (age_calc != age) {
          data_conflict <- TRUE
        }
      } else {
        age <- age_calc
        no_changes <- FALSE
      }
    }
    ########## If know age and DOB, calculate date
    if ( (!is.na(age)) && (!is.na(dob)) ) {
      date_calc <- dob + age
      if (!is.na(date)) {
        if (date_calc != date) {
          data_conflict <- TRUE
        }
      } else {
        date <- date_calc
        no_changes <- FALSE
      }
    }
    ########## If know age and date, calculate DOB
    if ( (!is.na(age)) && (!is.na(date)) ) {
      dob_calc <- date - age
      if (!is.na(dob)) {
        if (dob_calc != dob) {
          data_conflict <- TRUE
        }
      } else {
        dob <- dob_calc
        no_changes <- FALSE
      }
    }
    ########## If know GA and age, calculate PMA
    if ( (!is.na(ga)) && (!is.na(age)) ) {
      pma_calc <- days_to_weeks( weeks_to_days(ga) + age )
      if (!is.na(pma)) {
        if (pma_calc != pma) {
          data_conflict <- TRUE
        }
      } else {
        pma <- pma_calc
        no_changes <- FALSE
      }
    }
    ########## If know PMA and age, calculate GA
    if ( (!is.na(pma)) && (!is.na(age)) ) {
      ga_calc <- days_to_weeks( weeks_to_days(pma) - age )
      if (!is.na(ga)) {
        if (ga_calc != ga) {
          data_conflict <- TRUE
        }
      } else {
        ga <- ga_calc
        no_changes <- FALSE
      }
    }
    ########## If know GA and PMA, calculate age
    if ( (!is.na(ga)) && (!is.na(pma)) ) {
      age_calc <- weeks_to_days(pma) - weeks_to_days(ga)
      if (!is.na(age)) {
        if (age_calc != age) {
          data_conflict <- TRUE
        }
      } else {
        age <- age_calc
        no_changes <- FALSE
      }
    }
    ########## If know EDC and date, calculate PMA
    if ( (!is.na(edc)) && (!is.na(date)) ) {
      pma_calc <- days_to_weeks(280 - as.integer(edc - date)) # 280 days = 40 weeks
      if (!is.na(pma)) {
        if (pma_calc != pma) {
          data_conflict <- TRUE
        }
      } else {
        pma <- pma_calc
        no_changes <- FALSE
      }
    }
    ########## If know PMA and date, calculate EDC
    if ( (!is.na(pma)) && (!is.na(date)) ) {
      edc_calc <- date + 40*7 - weeks_to_days(pma)
      if (!is.na(edc)) {
        if (edc_calc != edc) {
          data_conflict <- TRUE
        }
      } else {
        edc <- edc_calc
        no_changes <- FALSE
      }
    }
    ########## If know PMA and EDC, calculate date
    if ( (!is.na(pma)) && (!is.na(edc)) ) {
      date_calc <- edc - 40*7 + weeks_to_days(pma)
      if (!is.na(date)) {
        if (date_calc != date) {
          data_conflict <- TRUE
        }
      } else {
        date <- date_calc
        no_changes <- FALSE
      }
    }
    if (no_changes || data_conflict) { break }
  }
  if (data_conflict) {
    warning("Input data inconsistency")
    return (NULL)
  } else {
    return(list(
      lmp = as.character(lmp),
      edc = as.character(edc),
      dob = as.character(dob),
      ga = ga,
      date = as.character(date),
      age = age,
      dol = dol,
      pma = pma)
    )
  }
}

Helper function to display ga_calc() results in table

test_ga_calc <- function(...) {
  # display ga_calc(lmp, edc, dob, date, ga, age, dol, pma) results in table
  l <- ga_calc(...)
  data.frame(
    field = names(l),
    value = unlist(l, use.names = FALSE)
  ) |>
  knitr::kable()
}

Example usage

If you only have a date of birth and age, there’s a fairly limited number of things that can be calculated.

test_ga_calc(
  dob = Sys.Date(),
  age = 10
)

field	value
lmp	NA
edc	NA
dob	2025-02-12
ga	NA
date	2025-02-22
age	10
dol	11
pma	NA

With more starting inputs, more things can be calculated.

test_ga_calc(
  date = "2025-02-04",
  dob = "2025-01-01",
  ga = "26 0/7"
)

field	value
lmp	2024-07-03
edc	2025-04-09
dob	2025-01-01
ga	26 0/7
date	2025-02-04
age	34
dol	35
pma	30 6/7

If contradictory input is submitted, the function fails with a warning.

test_ga_calc(
  date = "2025-01-03",
  dob = "2025-01-01",
  age = 10
)

Warning in ga_calc(...): Input data inconsistency