Fix xaxis alignment for ggkm

R/g_km.R

@@ -500,35 +500,28 @@ g_km <- function(df,
 
     gg_at_risk <- df2gg(
       at_risk_tbl,
-      font_size = font_size, col_labels = FALSE, hline = FALSE,
-      colwidths = rep(1, ncol(at_risk_tbl))
+      font_size = eargs$font_size, col_labels = FALSE, hline = FALSE,
+      colwidths = rep(1, ncol(at_risk_tbl)),
+      add_proper_xaxis = TRUE
     ) +
-      labs(title = if (annot_at_risk_title) "Patients at Risk:" else NULL, x = xlab) +
-      theme_bw(base_size = font_size) +
-      theme(
-        plot.title = element_text(size = font_size, vjust = 3, face = "bold"),
-        panel.border = element_blank(),
-        panel.grid = element_blank(),
-        axis.title.y = element_blank(),
-        axis.ticks.y = element_blank(),
-        axis.text.y = element_text(size = font_size, face = "italic", hjust = 1),
-        axis.text.x = element_text(size = font_size),
-        axis.line.x = element_line()
+      ggplot2::labs(title = if (!is.null(title)) title else NULL, x = xlab) +
+      ggplot2::theme_bw(base_size = eargs$font_size) +
+      ggplot2::theme(
+        plot.title = ggplot2::element_text(size = eargs$font_size, vjust = 3, face = "bold"),
+        panel.border = ggplot2::element_blank(),
+        panel.grid = ggplot2::element_blank(),
+        axis.title.y = ggplot2::element_blank(),
+        axis.ticks.y = ggplot2::element_blank(),
+        axis.text.y = ggplot2::element_text(size = eargs$font_size, face = "italic", hjust = 1),
+        axis.text.x = ggplot2::element_text(size = eargs$font_size),
+        axis.line.x = ggplot2::element_line()
       ) +
-      coord_cartesian(clip = "off", ylim = c(0.5, nrow(at_risk_tbl)))
-    gg_at_risk <- suppressMessages(
-      gg_at_risk +
-        scale_x_continuous(expand = c(0.025, 0), breaks = seq_along(at_risk_tbl) - 0.5, labels = xticks) +
-        scale_y_continuous(labels = rev(levels(annot_tbl$strata)), breaks = seq_len(nrow(at_risk_tbl)))
-    )
+      ggplot2::coord_cartesian(clip = "off", ylim = c(0.5, nrow(at_risk_tbl)))
 
     if (!as_list) {
       gg_plt <- cowplot::plot_grid(
-        gg_plt,
-        gg_at_risk,
-        align = "v",
-        axis = "tblr",
-        ncol = 1,
+        gg_plt, gg_at_risk,
+        align = "vh", axis = "b", ncol = 1,
         rel_heights = c(rel_height_plot, 1 - rel_height_plot)
       )
     }

R/utils_ggplot.R

@@ -147,6 +147,7 @@ rtable2gg <- function(tbl, fontsize = 12, colwidths = NULL, lbl_col_padding = 0)
 #'   if `col_labels = TRUE`). Defaults to `"bold"`.
 #' @param hline (`flag`)\cr whether a horizontal line should be printed below the first row of the table.
 #' @param bg_fill (`string`)\cr table background fill color.
+#' @param add_proper_xaxis (`flag`)\cr whether to add a proper x-axis with column values.
 #'
 #' @return A `ggplot` object.
 #'
@@ -157,61 +158,101 @@ rtable2gg <- function(tbl, fontsize = 12, colwidths = NULL, lbl_col_padding = 0)
 #' df2gg(head(iris, 5), font_size = 15, colwidths = c(1, 1, 1, 1, 1))
 #' }
 #' @keywords internal
-df2gg <- function(df,
-                  colwidths = NULL,
-                  font_size = 10,
-                  col_labels = TRUE,
-                  col_lab_fontface = "bold",
-                  hline = TRUE,
-                  bg_fill = NULL) {
-  # convert to text
-  df <- as.data.frame(apply(df, 1:2, function(x) if (is.na(x)) "NA" else as.character(x)))
+df2gg <- function(df, colwidths = NULL, font_size = 10, col_labels = TRUE,
+                  col_lab_fontface = "bold", hline = TRUE, bg_fill = NULL, add_proper_xaxis = FALSE) {
+  # Convert all values to character, replacing NAs with "NA"
+  df <- as.data.frame(apply(df, 1:2, function(x) {
+    if (is.na(x)) {
+      "NA"
+    } else {
+      as.character(x)
+    }
+  }))
 
+  # Add column labels as first row if specified
   if (col_labels) {
     df <- as.matrix(df)
     df <- rbind(colnames(df), df)
   }
 
-  # Get column widths
-  if (is.null(colwidths)) {
-    colwidths <- apply(df, 2, function(x) max(nchar(x), na.rm = TRUE))
-  }
-  tot_width <- sum(colwidths)
+  # Create ggplot2 object with x-axis specified in df
+  if (add_proper_xaxis) {
+    # Determine column widths if not provided
+    if (is.null(colwidths)) {
+      tot_width <- max(colnames(df) |> as.numeric(), na.rm = TRUE)
+      colwidths <- rep(floor(tot_width / ncol(df)), ncol(df))
+    } else {
+      tot_width <- sum(colwidths)
+    }
 
-  res <- ggplot(data = df) +
-    theme_void() +
-    scale_x_continuous(limits = c(0, tot_width)) +
-    scale_y_continuous(limits = c(1, nrow(df)))
+    df_long <- df |>
+      as.data.frame() |>
+      # 1. Ensure the row names ('A', 'B', 'C') are a column named 'row_name'
+      dplyr::mutate(row_name = row.names(df)) |>
+      # 2. Pivot the remaining columns (starting from '0' to the end) longer
+      tidyr::pivot_longer(
+        cols = -.data$row_name, # Select all columns EXCEPT 'row_name'
+        names_to = "col_name", # Name the new column containing the old column headers
+        values_to = "value" # Name the new column containing the data values
+      ) |>
+      dplyr::arrange(.data$row_name, .data$col_name) |>
+      dplyr::mutate(
+        col_name = as.numeric(.data$col_name),
+        row_name = factor(.data$row_name, levels = row.names(df))
+      )
+    res <- ggplot2::ggplot(data = df_long) +
+      ggplot2::theme_void() +
+      ggplot2::annotate("text",
+        x = df_long$col_name, y = rev(df_long$row_name), # why rev?
+        label = df_long$value, size = font_size / .pt
+      )
 
-  if (!is.null(bg_fill)) res <- res + theme(plot.background = element_rect(fill = bg_fill))
+    # Create ggplot2 object with a specific x-axis based on column widths
+  } else {
+    # Determine column widths if not provided
+    if (is.null(colwidths)) {
+      colwidths <- apply(df, 2, function(x) max(nchar(x), na.rm = TRUE))
+    }
+    tot_width <- sum(colwidths)
 
-  if (hline) {
-    res <- res +
-      annotate(
-        "segment",
-        x = 0 + 0.2 * colwidths[2], xend = tot_width - 0.1 * tail(colwidths, 1),
-        y = nrow(df) - 0.5, yend = nrow(df) - 0.5
-      )
-  }
+    res <- ggplot2::ggplot(data = df) +
+      ggplot2::theme_void() +
+      ggplot2::scale_x_continuous(limits = c(0, tot_width)) +
+      ggplot2::scale_y_continuous(limits = c(1, nrow(df)))
 
-  for (i in seq_len(ncol(df))) {
-    line_pos <- c(
-      if (i == 1) 0 else sum(colwidths[1:(i - 1)]),
-      sum(colwidths[1:i])
-    )
-    res <- res +
-      annotate(
-        "text",
-        x = mean(line_pos),
-        y = rev(seq_len(nrow(df))),
-        label = df[, i],
-        size = font_size / .pt,
-        fontface = if (col_labels) {
+
+    for (i in seq_len(ncol(df))) {
+      line_pos <- c(
+        if (i == 1) {
+          0
+        } else {
+          sum(colwidths[1:(i - 1)])
+        },
+        sum(colwidths[1:i])
+      )
+      res <- res + ggplot2::annotate("text",
+        x = mean(line_pos), y = rev(seq_len(nrow(df))),
+        label = df[, i], size = font_size / .pt, fontface = if (col_labels) {
           c(col_lab_fontface, rep("plain", nrow(df) - 1))
         } else {
           rep("plain", nrow(df))
         }
       )
+    }
+  }
+
+  # Add horizontal line if specified
+  if (hline) {
+    res <- res + ggplot2::annotate(
+      "segment",
+      x = 0 + 0.2 * colwidths[2], xend = tot_width - 0.1 * tail(colwidths, 1),
+      y = nrow(df) - 0.5, yend = nrow(df) - 0.5
+    )
+  }
+
+  # Set background fill if specified
+  if (!is.null(bg_fill)) {
+    res <- res + ggplot2::theme(plot.background = ggplot2::element_rect(fill = bg_fill))
   }
 
   res

tests/testthat/test-utils_ggplot.R

@@ -66,3 +66,27 @@ testthat::test_that("df2gg works as expected", {
   testthat::expect_silent(df2gg_cw <- head(iris, 5) %>% df2gg(colwidths = c(1, 1, 1, 1, 1)))
   expect_snapshot_ggplot("df2gg_cw", df2gg_cw, width = 5)
 })
+
+test_that("df2gg() works with proper x-axis and without", {
+  # Example using proper x-axis
+  df <- as.data.frame(matrix(c(
+    #  0,  250, 500, 750, 1000  <-- (Reference)
+    54,  28,  10,   3,    0,
+    59,  35,  16,   5,    1,
+    54,  25,   4,   0,    0
+  ), nrow = 3, byrow = TRUE))
+
+  # Set names manually
+  colnames(df) <- c("0", "250", "500", "750", "1000")
+  rownames(df) <- c("A", "B", "C")
+
+  # Example with proper x-axis
+  expect_no_error(
+    null <- df2gg(df, font_size = 8, add_proper_xaxis = TRUE)
+  )
+
+  # Example without proper x-axis
+  expect_no_error(
+    null <- df2gg(df, font_size = 8, add_proper_xaxis = FALSE, hline = FALSE)
+  )
+})