Fix ggcoxdiagnostics x-axis scaling for time option (#608)

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

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")})

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)
+})
+