22 add legend to the hr forest plot

R/format_hr_forestly.R

@@ -26,7 +26,7 @@
 #'   - `event`: Number of events in a comparison.
 #'   - `hr`: Hazard ratio estimate in a comparison.
 #'   - `fig_hr`: Hazard ratio figure in a comparison.
-#' @param digits A numeric value specifying the number of digits to
+#' @param digits_hr A numeric value specifying the number of digits to
 #'    display for hazard ratios and confidence intervals. Default is 2.
 #' @param width_subgroup A numeric value specifying the width of
 #'    the subgroup column in pixels.
@@ -36,6 +36,8 @@
 #' @param width_event A numeric value specifying the width of
 #'    the "event" column in pixels.
 #' @param width_hr A numeric value specifying the width of the hazard ratio column in pixels.
+#' @param digits_surv A numeric value specifying the number of digits to display
+#'    for the survival probability in KM curves.
 #' @param footer_space A numeric value specifying the space for the footer in pixels.
 #' @param hr_range A numeric vector of lower and upper limit of x-axis
 #'    for the hazard ratio figure.
@@ -60,13 +62,14 @@
 #'   format_hr_forestly()
 format_hr_forestly <- function(outdata,
                                display = c("n", "event", "fig_hr"),
-                               digits = 2,
+                               digits_hr = 2,
                                width_subgroup = 50,
-                               width_fig = 320,
+                               width_fig = 360,
                                width_n = 40,
                                width_event = 40,
                                width_hr = 40,
-                               footer_space = 90,
+                               digits_surv = 2,
+                               footer_space = 150,
                                hr_range = NULL,
                                color = NULL,
                                hr_label = "Treatment <- Favor -> Placebo") {
@@ -105,9 +108,9 @@ format_hr_forestly <- function(outdata,
   tbl <- data.frame(
     outdata$n,
     outdata$event[1:n_group1],
-    round(outdata$hr_est[1:n_group1], digits = digits),
-    round(outdata$hr_ci_lower[1:n_group1], digits = digits),
-    round(outdata$hr_ci_upper[1:n_group1], digits = digits),
+    round(outdata$hr_est[1:n_group1], digits = digits_hr),
+    round(outdata$hr_ci_lower[1:n_group1], digits = digits_hr),
+    round(outdata$hr_ci_upper[1:n_group1], digits = digits_hr),
     hr_fig = NA
   )
   col_names <- sapply(2:n_group, function(x) {
@@ -137,14 +140,14 @@ format_hr_forestly <- function(outdata,
   fig_hr_color <- color[2:n_group]
 
   iter <- 1:ncol(outdata$hr_est[1:n_group1]) - 1
-  text <- glue::glue("x[{iter}] + '(' + x_lower[{iter}] + ', ' + x_upper[{iter}] + ')'")
+  text <- glue::glue("x[{iter}] + ' (' + x_lower[{iter}] + ', ' + x_upper[{iter}] + ')'")
   js_hr_fig_cell <- sparkline_point_js(
     tbl = tbl,
     type = "cell",
     x = names(outdata$hr_est)[1:n_group1],
     x_lower = names(outdata$hr_ci_lower)[1:n_group1],
     x_upper = names(outdata$hr_ci_upper)[1:n_group1],
-    y = 1:n_group1,
+    y = rev(1:n_group1),
     xlim = fig_hr_range,
     color = fig_hr_color,
     width = width_fig,
@@ -154,15 +157,20 @@ format_hr_forestly <- function(outdata,
 
   # Function to create Axis
   js_hr_fig_footer <- sparkline_point_js(
-    tbl = data.frame(x = 1),
-    x = "x",
+    tbl = tbl,
+    x = names(outdata$hr_est)[1:n_group1],
     y = -1,
     type = "footer",
     xlab = hr_label,
     xlim = fig_hr_range,
     height = footer_space,
     width = width_fig,
-    legend = FALSE,
+    color = fig_hr_color,
+    legend = TRUE,
+    legend_label = outdata$group[2:n_group],
+    legend_title = "",
+    legend_position = -2,
+    legend_type = "point",
     margin = c(footer_space - 20, 20, 0, 0, 0)
   )
 
@@ -231,7 +239,7 @@ format_hr_forestly <- function(outdata,
         header = "HR",
         minWidth = width_hr,
         show = display_hr,
-        format = reactable::colFormat(digits = digits)
+        format = reactable::colFormat(digits = digits_hr)
       )
     }
   )
@@ -279,13 +287,21 @@ format_hr_forestly <- function(outdata,
     return(x)
   })
 
+  # Update km_data to round
+  km_data <- outdata$km_data |>
+    dplyr::mutate(
+      surv = round(surv, digits_surv),
+      text = paste0(endpoint, ": ", formatC(surv, format = "f", digits = digits_surv), "\n", "Number of participants at risk: ", n.risk)
+    )
+
   # Create outdata
   outdata$tbl <- tbl
   outdata$reactable_columns <- columns
   outdata$reactable_columns_group <- columnGroups
   outdata$display <- display
   outdata$fig_hr_color <- fig_hr_color
   outdata$color <- color
+  outdata$km_data <- km_data
 
   outdata
 }

R/hr_forestly.R

@@ -24,7 +24,7 @@
 #' @param y_label_kmplot A string specifying the y-axis label of the KM plot.
 #'    Default is "Survival Probability".
 #' @param width A numeric value of width of the entire plot in pixels. Default is 1000.
-#' @param height_kmoplot A numeric value of height of the KM plot in pixels. Default is 400.
+#' @param height_kmplot A numeric value of height of the KM plot in pixels. Default is 400.
 #' @param height_at_risk A numeric value of height of the at-risk table in pixels.
 #'    Default is 200.
 #' @param max_page A numeric value of maximum number of subgroups to display per page.
@@ -48,7 +48,7 @@ hr_forestly <- function(outdata,
                         time_unit = c("days", "weeks", "months", "years"),
                         y_label_kmplot = "Survival Probability",
                         width = 1000,
-                        height_kmoplot = 400,
+                        height_kmplot = 400,
                         height_at_risk = 200,
                         max_page = NULL) {
   time_unit <- match.arg(time_unit, choices = time_unit)
@@ -166,7 +166,7 @@ hr_forestly <- function(outdata,
 
           htmltools::div(
             htmltools::tagList(
-              ggplotly(km_plot, tooltip = c("text"), dynamicTicks = FALSE, height = height_kmoplot) %>%
+              ggplotly(km_plot, tooltip = c("text"), dynamicTicks = FALSE, height = height_kmplot) %>%
                 highlight(on = "plotly_click", off = "plotly_doubleclick") %>%
                 add_trace(
                   data = cnr_details,

R/prepare_hr_forestly.R

@@ -209,8 +209,7 @@ prepare_hr_forestly <- function(meta = NULL,
           km_extract() |>
           dplyr::mutate(
             endpoint = endpt_label,
-            subgroup = km_curve_val,
-            text = paste0(endpoint, ": ", surv, "\n", "Number of participants at risk: ", n.risk)
+            subgroup = km_curve_val
           )
       })
       km_tbl_new <- do.call(rbind, km_tbl_new)

inst/js/sparkline.js

@@ -106,7 +106,8 @@ function(cell, state) {
         "orientation": "h",
         "xanchor": "center",
         "x": 0.5,
-        "y": legend_position
+        "y": legend_position,
+        "yref": "container"
       }
     },
     "config": {