Fix issue 83 slider range

.Rbuildignore

@@ -16,3 +16,5 @@
 ^vignettes/layout.Rmd$
 ^vignettes/meta-forestly.Rmd$
 
+^CLAUDE\.md$
+^data-raw$

CLAUDE.md

@@ -0,0 +1,74 @@
+# Claude Code Assistant Instructions
+
+## Project Overview
+This is the forestly R package, which creates interactive forest plots for clinical trial data analysis. The package is built on top of metalite and metalite.ae packages and uses reactable for interactive tables with Plotly.js for interactive visualizations.
+
+## Development Guidelines
+
+### Testing
+- load project using `devtools::load_all()`
+- Run tests using: `devtools::test()`
+- Run specific test files using: `devtools::test(filter = "filename")`
+- Before running tests, ensure required packages are installed (metalite, metalite.ae, reactable, reactR)
+
+### Code Style
+- Follow tidyverse style guide
+- Use `|>` pipe operator (R 4.1+)
+- Functions should handle both character vectors and factors robustly
+
+### Key Functions
+- `ae_forestly()`: Main function to create interactive forest plots
+- `format_ae_forestly()`: Formats AE data and configures Plotly visualizations
+- `format_ae_listing()`: Formats AE listing data
+- `sparkline_point_js()`: Generates JavaScript/Plotly code for interactive sparkline plots
+- `propercase()`: Converts strings to proper case (handles factors)
+- `titlecase()`: Converts strings to title case using tools::toTitleCase (handles factors)
+
+### Before Committing
+- Run linting: Check for any linting issues in the IDE
+- Run tests: `devtools::test()` to ensure all tests pass
+- Check documentation: `devtools::document()` if roxygen comments are updated
+
+### Branch Strategy
+- Main branch: `main`
+- Feature branches: Use descriptive names like `fix-factor-handling` or `add-new-feature`
+- Always create pull requests for merging into main
+
+### Common Commands
+```r
+# Load all functions for development
+devtools::load_all()
+
+# Run all tests
+devtools::test()
+
+# Check package
+devtools::check()
+
+# Build documentation
+devtools::document()
+```
+
+## Package Dependencies
+- metalite
+- metalite.ae
+- reactable
+- reactR
+- plotly (via JavaScript integration)
+- brew (for template processing)
+- tools (base R)
+
+## Testing Data
+The package includes test data in `data/`:
+- forestly_adae.rda
+- forestly_adae_3grp.rda
+- forestly_adsl.rda
+- forestly_adsl_3grp.rda
+
+## Notes for Future Development
+- The `ae_listing.R` file contains functions that handle factor inputs, which was a recent fix
+- Test files should use `devtools::load_all()` or source the R files directly for testing
+- The package uses testthat for unit testing framework
+- Interactive plots use Plotly.js via JavaScript templates in `inst/js/`
+- The y-axis ordering in `format_ae_forestly.R` affects the visual display in interactive plots
+- When debugging interactive plot issues, check both R code and JavaScript template files

R/ae_forestly.R

@@ -22,6 +22,9 @@
 #' @param display_soc_toggle A boolean value to display SOC toggle button.
 #' @param filter A character value of the filter variable.
 #' @param filter_label A character value of the label for slider bar.
+#' @param filter_range A numeric vector of length 2 for the range of the slider bar.
+#'   If NULL (default), the range is automatically calculated from the data.
+#'   If only one value is provided, it will be used as the maximum and minimum will be 0.
 #' @param width A numeric value of width of the table in pixels.
 #' @param max_page A numeric value of max page number shown in the table.
 #'
@@ -46,12 +49,46 @@ ae_forestly <- function(outdata,
                         display_soc_toggle = TRUE,
                         filter = c("prop", "n"),
                         filter_label = NULL,
+                        filter_range = NULL,
                         width = 1400,
                         max_page = NULL) {
   filter <- match.arg(filter)
-  filter_range <- c(0, 100)
 
-  if(is.null(filter_label)) {
+  # Handle filter_range parameter
+  if (!is.null(filter_range)) {
+    # User provided filter_range
+    if (length(filter_range) == 1) {
+      # If only one value provided, use it as max with min=0
+      filter_range <- c(0, filter_range[1])
+    } else if (length(filter_range) == 2) {
+      # Use as provided
+      filter_range <- filter_range
+    } else {
+      stop("filter_range must be NULL, a single numeric value, or a numeric vector of length 2")
+    }
+  } else {
+    # Auto-detect range from data
+    if (filter == "prop") {
+      # For proportion, get max from hide_prop column
+      max_val <- max(outdata$tbl$hide_prop, na.rm = TRUE)
+      # Round up to nearest 10 for better UX
+      max_val <- ceiling(max_val / 10) * 10
+      # Ensure at least 100 for proportion
+      filter_range <- c(0, max(100, max_val))
+    } else if (filter == "n") {
+      # For count, get max from hide_n column
+      max_val <- max(outdata$tbl$hide_n, na.rm = TRUE)
+      # Round up to nearest 10 (or 5 if max is small)
+      if (max_val <= 20) {
+        max_val <- ceiling(max_val / 5) * 5
+      } else {
+        max_val <- ceiling(max_val / 10) * 10
+      }
+      filter_range <- c(0, max_val)
+    }
+  }
+
+  if (is.null(filter_label)) {
     filter_label <- ifelse(filter == "prop",
                            "Incidence (%) in One or More Treatment Groups",
                            "Number of AE in One or More Treatment Groups")
@@ -133,12 +170,10 @@ ae_forestly <- function(outdata,
     )
   }
 
-  filter_subject$children[[2]]$attribs$`data-from` <- 0
-
-  data_to <- ceiling(as.numeric(filter_subject$children[[2]]$attribs$`data-to`))
-  data_to <- (data_to %/% 10 + 1) * 10
-  filter_subject$children[[2]]$attribs$`data-to` <- data_to
-  filter_subject$children[[2]]$attribs$`data-max` <- data_to
+  # Set the slider attributes to match our filter_range
+  filter_subject$children[[2]]$attribs$`data-from` <- filter_range[1]
+  filter_subject$children[[2]]$attribs$`data-to` <- filter_range[2]
+  filter_subject$children[[2]]$attribs$`data-max` <- filter_range[2]
 
   p_reactable <- reactable2(
     tbl,

R/format_ae_forestly.R

@@ -39,6 +39,10 @@
 #' @param color A vector of colors for analysis groups.
 #'   Default value supports up to 4 groups.
 #' @param diff_label x-axis label for risk difference.
+#' @param col_header Column header for risk difference table columns.
+#'   If NULL (default), uses "Risk Difference (%) <br> vs. Reference Group".
+#' @param fig_header Column header for risk difference figure.
+#'   If NULL (default), uses "Risk Difference (%) + 95% CI <br> vs. Reference Group".
 #' @param show_ae_parameter A boolean value to display AE parameter column.
 #'
 #' @return An `outdata` object.
@@ -68,6 +72,8 @@ format_ae_forestly <- function(
     diff_range = NULL,
     color = NULL,
     diff_label = "Treatment <- Favor -> Placebo",
+    col_header = NULL,
+    fig_header = NULL,
     show_ae_parameter = FALSE) {
   display <- tolower(display)
 
@@ -77,6 +83,8 @@ format_ae_forestly <- function(
     several.ok = TRUE
   )
 
+  display_n <- "n" %in% display
+  display_prop <- "prop" %in% display
   display_total <- "total" %in% display
   display_diff <- "diff" %in% display
 
@@ -93,6 +101,18 @@ format_ae_forestly <- function(
   name_n <- names(outdata$n)[1:m_group]
   name_prop <- names(outdata$prop)[1:m_group]
 
+  # Get reference group name for headers
+  reference_name <- outdata$group[index_reference]
+
+  # Set default headers if not provided
+  if (is.null(col_header)) {
+    col_header <- paste0("Risk Difference (%) <br> vs. ", reference_name)
+  }
+
+  if (is.null(fig_header)) {
+    fig_header <- paste0("Risk Difference (%) + 95% CI <br> vs. ", reference_name)
+  }
+
   # Input checking
   if (is.null(color)) {
     if (n_group <= 2) {
@@ -131,7 +151,7 @@ format_ae_forestly <- function(
   tbl_prop <- outdata$prop[, 1:n_group]
   y <- rep(NA, n_group)
   y[outdata$reference_group] <- mean(1:n_group1)
-  y[-outdata$reference_group] <- 1:n_group1
+  y[-outdata$reference_group] <- rev(1:n_group1)
 
   # Calculate the range of the forest plot
   if (is.null(prop_range)) {
@@ -199,7 +219,7 @@ format_ae_forestly <- function(
     x = names(outdata$diff),
     x_lower = names(outdata$ci_lower),
     x_upper = names(outdata$ci_upper),
-    y = 1:ncol(outdata$diff),
+    y = rev(1:ncol(outdata$diff)),
     xlim = fig_diff_range,
     color = fig_diff_color,
     width = width_fig,
@@ -231,7 +251,7 @@ format_ae_forestly <- function(
     )
   }
   columnGroups[[m_group + 1]] <- reactable::colGroup(
-    name = "Risk Difference (%) <br> vs. Placebo",
+    name = col_header,
     html = TRUE,
     columns = names(outdata$diff)
   )
@@ -259,7 +279,8 @@ format_ae_forestly <- function(
   col_n <- lapply(name_n, function(x) {
     reactable::colDef(
       header = "n", defaultSortOrder = "desc",
-      minWidth = width_n, align = "center"
+      minWidth = width_n, align = "center",
+      show = display_n
     )
   })
   names(col_n) <- name_n
@@ -269,6 +290,7 @@ format_ae_forestly <- function(
     reactable::colDef(
       header = "(%)", defaultSortOrder = "desc",
       minWidth = width_prop, align = "center",
+      show = display_prop,
       format = reactable::colFormat(
         prefix = "(",
         digits = digits,
@@ -320,7 +342,7 @@ format_ae_forestly <- function(
 
   # difference format
   col_diff_fig <- list(diff_fig = reactable::colDef(
-    header = "Risk Difference (%) + 95% CI <br> vs. Placebo",
+    header = fig_header,
     defaultSortOrder = "desc",
     width = ifelse("fig_diff" %in% display, width_fig, 0),
     align = "center",