api.R

# Plumber API exposing BCRA::absolute.risk
# This file defines a GET and POST endpoint /gailrisk

library(plumber)

#* Return version and readiness
#* @get /
function() list(service = "BCRA Gail Model API", status = "ready")

#* Calculate Gail Model absolute risk (5-year and lifetime)
#* @param age Numeric: current age
#* @param nbiops Integer: number of previous breast biopsies
#* @param hyperplasia Integer 0/1: history of hyperplasia
#* @param ageMenarche Numeric: age at menarche
#* @param ageFirstLiveBirth Numeric or NA: age at first live birth (use NA if null)
#* @param nRelatives Integer: number of first-degree relatives with breast cancer
#* @param race Integer code: see BCRA docs (1=White,2=Black,3=Hispanic, etc.)
#* @post /gailrisk
#* @json
function(req, res, age, nbiops, hyperplasia, ageMenarche, ageFirstLiveBirth = NA, nRelatives = 0, race = 1){
  # Lazy-load BCRA only when endpoint is called to avoid failing if not installed
  if(!requireNamespace("BCRA", quietly = TRUE)){
    res$status <- 500
    return(list(error = "BCRA package not installed. Run install_packages.R to install dependencies."))
  }
  # Convert and validate inputs
  numeric_or_na <- function(x){ if(is.null(x) || identical(x, "") || is.na(x)) return(NA_real_) else return(as.numeric(x)) }

  age <- numeric_or_na(age)
  nbiops <- as.integer(numeric_or_na(nbiops))
  hyperplasia <- as.integer(numeric_or_na(hyperplasia))
  ageMenarche <- numeric_or_na(ageMenarche)
  ageFirstLiveBirth <- numeric_or_na(ageFirstLiveBirth)
  nRelatives <- as.integer(numeric_or_na(nRelatives))
  race <- as.integer(numeric_or_na(race))

  # Basic checks
  if(is.na(age) || age < 20 || age > 90){ res$status <- 400; return(list(error = "age must be a number between 20 and 90")) }
  if(is.na(nbiops)) nbiops <- 0
  if(is.na(hyperplasia)) hyperplasia <- 0
  if(is.na(ageMenarche)) ageMenarche <- NA_real_
  if(is.na(nRelatives)) nRelatives <- 0
  if(is.na(race)) race <- 1

  # BCRA expects a data.frame where columns include T1 (initial age), T2 (projection age), and BRCA risk covariates.
  # We'll produce two projections: 5-year and lifetime (to age 90).
  T1 <- age
  T2_5yr <- age + 5
  T2_life <- 90

  # Construct a helper that builds the required data.frame per BCRA exampledata fields.
  build_row <- function(T1, T2){
    # The BCRA package expects many columns. We'll include the minimal ones used in recode.check and relative.risk
    # Fields observed in package source: Age (initial) -> T1, T2, Age at menarche -> AgeM, Age at first live birth -> AgeFirst
    # nRelatives -> NumRel, nbiops -> NumBips, hyperplasia -> Hyp

    data.frame(
      T1 = as.numeric(T1),
      T2 = as.numeric(T2),
      Age = as.numeric(T1),
      AgeM = as.numeric(ageMenarche),
      AgeFirst = as.numeric(ageFirstLiveBirth),
      NumRel = as.integer(nRelatives),
      NumBips = as.integer(nbiops),
      Hyp = as.integer(hyperplasia),
      Race = as.integer(race),
      stringsAsFactors = FALSE
    )
  }

  # Build data frames
  df5 <- build_row(T1, T2_5yr)
  dflife <- build_row(T1, T2_life)

  # Call absolute.risk on each
  suppressWarnings({
    result5 <- try(BCRA::absolute.risk(df5), silent = TRUE)
    resultLife <- try(BCRA::absolute.risk(dflife), silent = TRUE)
  })

  if(inherits(result5, "try-error") || inherits(resultLife, "try-error")){
    res$status <- 500
    return(list(error = "BCRA::absolute.risk failed. Check that inputs map correctly to required covariates."))
  }

  # absolute.risk returns a numeric vector (percent). Extract first element
  five_year_risk <- as.numeric(result5[1])
  lifetime_risk <- as.numeric(resultLife[1])

  list(
    age = age,
    five_year_risk_percent = five_year_risk,
    lifetime_risk_percent = lifetime_risk,
    raw = list(result5 = result5, resultLife = resultLife)
  )
}