diff --git a/R/g_km.R b/R/g_km.R index 3fab8a8ddf..b66f78ca5f 100644 --- a/R/g_km.R +++ b/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) ) } diff --git a/R/utils_ggplot.R b/R/utils_ggplot.R index 4e5106cece..f974e89948 100644 --- a/R/utils_ggplot.R +++ b/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 diff --git a/man/df2gg.Rd b/man/df2gg.Rd index 0680270103..6aeacc7915 100644 --- a/man/df2gg.Rd +++ b/man/df2gg.Rd @@ -11,7 +11,8 @@ df2gg( col_labels = TRUE, col_lab_fontface = "bold", hline = TRUE, - bg_fill = NULL + bg_fill = NULL, + add_proper_xaxis = FALSE ) } \arguments{ @@ -32,6 +33,8 @@ if \code{col_labels = TRUE}). Defaults to \code{"bold"}.} \item{hline}{(\code{flag})\cr whether a horizontal line should be printed below the first row of the table.} \item{bg_fill}{(\code{string})\cr table background fill color.} + +\item{add_proper_xaxis}{(\code{flag})\cr whether to add a proper x-axis with column values.} } \value{ A \code{ggplot} object. diff --git a/tests/testthat/test-utils_ggplot.R b/tests/testthat/test-utils_ggplot.R index 31b89c94b1..3bd57f6d76 100644 --- a/tests/testthat/test-utils_ggplot.R +++ b/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) + ) +})