agreement.metrics <- function(dat) { ## Purpose: ## Calculate agreement metrics. ## ## Author: Feiming Chen ## ## Arguments: ## - dat : a data frame with the following variable names and with no NA values ## subject - subject identifier ## reference - continuous response from reference ## device - continuous response from device ## ## Return: ## - a list of agreement metrics (MAE, MAE%, RMSE, LOA, Bias, Average Correlation). ## ## ________________________________________________ reference.mean <- mean(dat$reference) dat$difference <- dat$device - dat$reference ## Bland-Altman Analysis with Repeated Measures BA.analysis <- bland.altman.repeated.vary(difference ~ factor(subject), dat, silent = TRUE) ## For MAE and RMSE MAE <- mean(abs(dat$difference)) # Mean Absolute Error MAE.pct <- MAE / reference.mean RMSE <- sqrt(mean(dat$difference^2)) # Root Mean Squared Error ## For Correlation: calculate patient-level summary metrics from repeated measures, then average across patients. ds <- split(dat, dat$subject) sapply(ds, function(d) cor(d$reference, d$device, method = "pearson")) -> ds2 Correlation <- mean(ds2) c(ref.mean = reference.mean, MAE = MAE, MAE.pct = MAE.pct, RMSE = RMSE, Correlation = Correlation, Bias = BA.analysis$m, SD = BA.analysis$s, LoA.L = BA.analysis$loa[1], LoA.U = BA.analysis$loa[2], SD0 = BA.analysis$s0, # no adjustment for repeated measurements LoA.L0 = BA.analysis$loa0[1], # no adjustment for repeated measurements LoA.U0 = BA.analysis$loa0[2]) # no adjustment for repeated measurements } if (F) { agreement.metrics(data.frame(subject = rep(1:30, 10), reference = 5 + rnorm(300), device = 6 + rnorm(300))) } agreement.analysis <- function(dat, boot.size = 2000) { ## Purpose: ## Calculate agreement metrics (MAE, MAE%, RMSE, LOA, Bias, Average Correlation) ## with their CI's, even in the presence of repeated measurements. ## ## Author: Feiming Chen ## ## Arguments: ## - dat : a data frame with the following variable names ## subject - subject identifier ## reference - continuous response from reference ## device - continuous response from device ## - boot.size : bootstrap sample size. ## ## Return: ## - Point estimates and 95% CI's for a list of agreement metrics (MAE, MAE%, RMSE, LOA, Bias, Average Correlation). ## ## ________________________________________________ id <- dat$subject unique.ID <- unique(id) N <- length(unique.ID) cat("Number of Unique Patients =", N, "\n") K <- nrow(dat) / N cat("Total number of repeated measurements =", nrow(dat), "\n") cat("Average number of repeated measurements per patient =", K, "\n") ## Point Estimates est <- agreement.metrics(dat) cat("\nPoint Estimates of Agreement Metrics:\n") print(round(est, 4)) ## 2000 Bootstrap Samples cat("\nBootstrap Sample Size =", boot.size, "\n") set.seed(1) replicate(n = boot.size, { s <- sample(unique.ID, replace = TRUE) # a bootstrap sample of patient ID's ## find all rows with the ID's in the bootstrap sample of ID's v <- c() for (j in s) v <- c(v, which(id == j)) # a new bootstrap sample agreement.metrics(dat[v,]) }) -> est.boot CI <- apply(est.boot, 1, function(x) quantile(x, c(0.025, 0.975))) cat("95% Bootstrap Percentile Confidence Intervals of Agreement Metrics:\n") print(round(CI, 4)) invisible(list(est = est, CI = CI))} if (F) { # Unit Test ## ans <- agreement.analysis(dat, boot.size = 10) }
Tuesday, February 28, 2023
Agreement Analysis for Continuous Data with Repeated Measurements
Subscribe to:
Post Comments (Atom)
No comments:
Post a Comment