R Under development (unstable) (2026-03-23 r89685 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2026 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> library(pedbp)
> 
> ################################################################################
> # These tests encode the intended corrected behavior for the blood-pressure
> # height-percentile scale bugs documented by the reprex scripts in the repo
> # root. They are expected to fail until the implementation is patched.
> 
> x <- q_bp(
+   p_sbp = 0.85,
+   p_dbp = 0.95,
+   age = 29.2,
+   male = 0,
+   height_percentile = 95,
+   source = "flynn2017"
+ )
> 
> current_bp_cdf_replay <- p_bp(
+   q_sbp = x$sbp,
+   q_dbp = x$dbp,
+   age = attr(x, "bp_params")$age,
+   male = attr(x, "bp_params")$male,
+   height_percentile = attr(x, "bp_params")$height_percentile,
+   source = attr(x, "bp_params")$source
+ )
> 
> stopifnot(abs(current_bp_cdf_replay$sbp_p - 0.85) < 1e-7)
> stopifnot(abs(current_bp_cdf_replay$dbp_p - 0.95) < 1e-7)
> 
> 
> ################################################################################
> # bp_cdf.default should not force height_percentile = 0.5 into the BP engine.
> 
> bp_default <- p_bp(
+   q_sbp = 103,
+   q_dbp = 55,
+   age = 96,
+   male = 1
+ )
> 
> bp_cdf_default_replay <- p_bp(
+   q_sbp = 103,
+   q_dbp = 55,
+   age = 96,
+   male = 1,
+   height_percentile = 50
+ )
> 
> stopifnot(identical(attr(bp_cdf_default_replay, "bp_params")$source, "nhlbi"))
> stopifnot(identical(attr(bp_cdf_default_replay, "bp_params")$height_percentile, 50))
> stopifnot(abs(bp_cdf_default_replay$sbp_p - 0.6524249) < 1e-7)
> stopifnot(abs(bp_cdf_default_replay$dbp_p - 0.3605785) < 1e-7)
> stopifnot(abs(bp_cdf_default_replay$sbp_p - bp_default$sbp_p) > 1e-7)
> stopifnot(abs(bp_cdf_default_replay$dbp_p - bp_default$dbp_p) > 1e-7)
> 
> 
> ################################################################################
> # Decimal height percentiles should not be silently reinterpreted as whole
> # percentiles.
> 
> bp_95 <- p_bp(
+   q_sbp = 100,
+   q_dbp = 60,
+   age = 44,
+   male = 1,
+   height_percentile = 95,
+   source = "nhlbi"
+ )
> 
> bp_095 <- p_bp(
+   q_sbp = 100,
+   q_dbp = 60,
+   age = 44,
+   male = 1,
+   height_percentile = 0.95,
+   source = "nhlbi"
+ )
Warning message:
'height_percentile' is expressed in percentile points on a 0-100 scale. Values between 0 and 1 are treated literally, so 0.95 means the 0.95th percentile, not the 95th percentile. 
> 
> stopifnot(identical(attr(bp_095, "bp_params")$height_percentile, 5))
> stopifnot(abs(bp_095$sbp_p - 0.9000536) < 1e-7)
> stopifnot(abs(bp_095$dbp_p - 0.9152593) < 1e-7)
> stopifnot(abs(bp_095$sbp_p - bp_95$sbp_p) > 1e-7)
> stopifnot(abs(bp_095$dbp_p - bp_95$dbp_p) > 1e-7)
> 
> warn_test <- tryCatch(
+   p_bp(
+     q_sbp = 100,
+     q_dbp = 60,
+     age = 44,
+     male = 1,
+     height_percentile = 0.95,
+     source = "nhlbi"
+   ),
+   warning = function(w) w
+ )
> 
> stopifnot(inherits(warn_test, "warning"))
> stopifnot(grepl("0-100 scale", warn_test$message, fixed = TRUE))
> 
> ################################################################################
> ##                                End of File                                 ##
> ################################################################################
> 
> proc.time()
   user  system elapsed 
   0.17    0.09    0.25