diff --git a/NEWS.md b/NEWS.md index 2c36205..58f4f2e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -8,6 +8,7 @@ ## Bug fixes +- Fix `ggcoxdiagnostics()` x-axis scaling when using `ox.scale = "time"` with Schoenfeld residuals (#608) - Fix ggplot2 3.5.0 aesthetic length warning when using `surv.median.line = "hv"` or `"h"` with multiple survival curves (#643) - Fix compatibility with ggplot2 development version (#681): Remove manual class assignment in `theme_survminer()` to ensure proper theme object construction - Fix test suite compatibility with ggplot2 development version (#681): Update layer access syntax in tests to support both stable (`$layers`) and development (`@layers`) versions diff --git a/R/ggcoxdiagnostics.R b/R/ggcoxdiagnostics.R index 4af1f75..9fd7067 100644 --- a/R/ggcoxdiagnostics.R +++ b/R/ggcoxdiagnostics.R @@ -89,7 +89,13 @@ ggcoxdiagnostics <- function (fit, time = { if (!(type %in% c("schoenfeld", "scaledsch"))) warning("ox.scale='time' works only with type=schoenfeld/scaledsch") - xval <- as.numeric(rownames(res)) + # Extract time values from residuals attributes + residuals_obj <- resid(fit, type = type) + if(NCOL(residuals_obj) == 1) { + xval <- as.numeric(attr(residuals_obj, "names")) + } else { + xval <- as.numeric(attr(residuals_obj, "dimnames")[[1]]) + } xlabel <- "Time" }, {warning("ox.scale should be one of linear.predictions/observation.id/time")}) diff --git a/tests/testthat/test-ggcoxdiagnostics.R b/tests/testthat/test-ggcoxdiagnostics.R index eb173f1..3d084bf 100644 --- a/tests/testthat/test-ggcoxdiagnostics.R +++ b/tests/testthat/test-ggcoxdiagnostics.R @@ -14,3 +14,46 @@ test_that('ggcoxdiagnostics with second type two rows for each observed event*te expect_equal(nrow(.build$data[[1]]), qty_terms*qty_events) }) +test_that('ggcoxdiagnostics with ox.scale="time" shows correct event times for schoenfeld residuals', { + cph <- coxph(Surv(futime, fustat) ~ rx + age, data=ovarian) + p <- ggcoxdiagnostics(cph, type="schoenfeld", ox.scale="time") + .build <- ggplot_build(p) + + # Extract expected time values from residuals attributes + residuals_obj <- resid(cph, type = "schoenfeld") + expected_times <- as.numeric(attr(residuals_obj, "dimnames")[[1]]) + + # Check that x-axis contains the expected time values (may be repeated for each covariate) + x_values <- unique(.build$data[[1]]$x) + expect_equal(sort(x_values), sort(expected_times)) +}) + +test_that('ggcoxdiagnostics with ox.scale="time" shows correct event times for scaledsch residuals', { + cph <- coxph(Surv(futime, fustat) ~ rx + age, data=ovarian) + p <- ggcoxdiagnostics(cph, type="scaledsch", ox.scale="time") + .build <- ggplot_build(p) + + # Extract expected time values from residuals attributes + residuals_obj <- resid(cph, type = "scaledsch") + expected_times <- as.numeric(attr(residuals_obj, "dimnames")[[1]]) + + # Check that x-axis contains the expected time values (may be repeated for each covariate) + x_values <- unique(.build$data[[1]]$x) + expect_equal(sort(x_values), sort(expected_times)) +}) + +test_that('ggcoxdiagnostics with ox.scale="time" works with univariate model', { + # Test with single covariate to check NCOL==1 case + cph <- coxph(Surv(futime, fustat) ~ age, data=ovarian) + p <- ggcoxdiagnostics(cph, type="schoenfeld", ox.scale="time") + .build <- ggplot_build(p) + + # Extract expected time values from residuals attributes + residuals_obj <- resid(cph, type = "schoenfeld") + expected_times <- as.numeric(attr(residuals_obj, "names")) + + # Check that x-axis values match residuals time attributes + x_values <- .build$data[[1]]$x + expect_equal(x_values, expected_times) +}) +