From b7febebce27237e83b7c10fe38708766d88683a9 Mon Sep 17 00:00:00 2001
From: niup0 <poyao.niu@merck.com>
Date: Wed, 25 Sep 2024 15:04:56 -0400
Subject: [PATCH 01/10] first commitment

---
 R/react_disposition.R | 237 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 237 insertions(+)
 create mode 100644 R/react_disposition.R

diff --git a/R/react_disposition.R b/R/react_disposition.R
new file mode 100644
index 0000000..a1bb45d
--- /dev/null
+++ b/R/react_disposition.R
@@ -0,0 +1,237 @@
+# Copyright (c) 2024 Merck & Co., Inc., Rahway, NJ, USA and its affiliates.
+# All rights reserved.
+#
+# This file is part of the metalite.sl program.
+#
+# metalite.sl is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+#' Display interactive disposition tables with AE subgroup analysis
+#'
+#' @param metadata_sl A metadata created by [metalite],
+#'   which builds the baseline characteristic table
+#' @param metadata_ae A metadata created by [metalite],
+#'   which builds the AE subgroup specific table
+#' @param population A character value of population term name.
+#'   The term name is used as key to link information.
+#' @param observation A character value of observation term name.
+#'   The term name is used as key to link information.
+#' @param display_total Display total column or not.
+#' @param sl_parameter A character value of parameter term name for
+#'   the baseline characteristic table.
+#'   The term name is used as key to link information.
+#' @param ae_subgroup A vector of strubf to specify the subgroups
+#'   in the AE subgroup specific table.
+#' @param ae_specific A string specifying the AE specific category.
+#' @param width A numeric value of width of the table in pixels.
+#'
+#' @return An reactable combing both baseline characteristic table
+#'   and AE subgroup specific tables.
+#'
+#' @export
+#'
+#' @examples
+#' if (interactive()) {
+#'   react_disposition(
+#'     metadata_sl = meta_sl_example(),
+#'     metadata_ae = metalite.ae::meta_ae_example(),
+#'     width = 1200
+#'   )
+#' }
+react_disposition <- function(
+    metadata_sl,
+    metadata_ae,
+    analysis = 'disp',
+    population = meta$plan[meta$plan$analysis==analysis,]$population,
+    sl_parameter = paste(meta$plan[meta$plan$analysis==analysis,]$parameter, collapse = ";"),
+    # observation = "wk12",
+    display_total = TRUE,
+    #ae_subgroup = c("gender", "race"),
+    #ae_specific = "rel",
+    width = 1200) {
+  # ----------------------------------------- #
+  #   total setting                           #
+  # ----------------------------------------- #
+  
+  if (display_total == TRUE) {
+    display_sl <- c("n", "prop", "total")
+  } else {
+    display_sl <- c("n", "prop")
+  }
+  
+  # ----------------------------------------- #
+  #   prepare the baseline char table numbers #
+  # ----------------------------------------- #
+  x_sl <- metadata_sl |>
+    prepare_disposition(
+      population = population,
+      analysis = analysis,
+      parameter = sl_parameter
+    ) |>
+    format_disposition(display_col = display_sl, digits_prop = 2)
+  
+  tbl_sl <- x_sl$tbl
+  tbl_sl$var_label[tbl_sl$name == "Participants in population"] <- "Participants in population"
+  
+  # ----------------------------------------- #
+  #   prepare the AE subgroup table numbers   #
+  # ----------------------------------------- #
+  # get the variable name of the subgroup
+  # ae_subgrp_var <- NULL
+  # ae_subgrp_label <- NULL
+  # for (x_subgrp in ae_subgroup) {
+  #   if (length(metalite::collect_adam_mapping(metadata_sl, x_subgrp)$vargroup) > 0) {
+  #     ae_subgrp_var <- c(ae_subgrp_var, metalite::collect_adam_mapping(metadata_sl, x_subgrp)$vargroup)
+  #   } else {
+  #     ae_subgrp_var <- c(ae_subgrp_var, metalite::collect_adam_mapping(metadata_sl, x_subgrp)$var)
+  #   }
+  #   ae_subgrp_label <- c(ae_subgrp_label, metalite::collect_adam_mapping(metadata_sl, x_subgrp)$label)
+  # }
+  
+  # get the AE subgroup tables
+  # tbl_ae <- list()
+  # group_ae <- list()
+  # 
+  # for (y_subgrp in ae_subgrp_var) {
+  #   tbl_ae_temp <- metalite.ae::prepare_ae_specific_subgroup(
+  #     metadata_ae,
+  #     population = population,
+  #     observation = observation,
+  #     parameter = ae_specific,
+  #     subgroup_var = y_subgrp,
+  #     display_subgroup_total = FALSE # total display for subgroup is not needed
+  #   ) |>
+  #     format_ae_specific_subgroup()
+  #   
+  #   tbl_ae <- c(tbl_ae, list(tbl_ae_temp$tbl))
+  #   # get group labels for AE analysis
+  #   group_ae <- c(group_ae, list(tbl_ae_temp$group))
+  #   # Note: Need to confirm whether treatment total can be displayed in ae subgroup
+  #   # if (display_total == TRUE){
+  #   #   group_ae <- c(group_ae, list(tbl_ae_temp$group))
+  #   # } else {
+  #   #   group_ae <- c(group_ae, list(tbl_ae_temp$group[!(tbl_ae_temp$group %in% "total")]))
+  #   # }
+  # }
+  
+  # get the AE specific
+  # ae_listing_outdata <- metalite.ae::prepare_ae_listing(
+  #   metadata_ae,
+  #   analysis = 'ae_listing',
+  #   population = population,
+  #   observation = observation,
+  #   parameter = 'any'
+  # ) |>
+  #   forestly:::format_ae_listing(display = display_sl)
+  
+  ae_listing_outdata <- metalite.ae::prepare_ae_specific(metadata_ae, "apat", "wk12", "any") |>
+    forestly:::collect_ae_listing(
+      c(
+        "USUBJID", "SEX", "RACE", "AGE", "ASTDY", "AESEV", "AESER",
+        "AEREL", "AEACN", "AEOUT", "SITEID", "ADURN", "ADURU", "AOCCPFL"
+      )
+    ) |>
+    forestly:::format_ae_listing()
+  
+  # Define Column and Column Group for AE specific
+  # col_defs_ae <- list()
+  # col_group_defs_ae <- list()
+  # col_defs_ae[["name"]] <- reactable::colDef(name = " ")
+  # for (i in 1:length(ae_specific_outdata$group)) {
+  #   col_defs_ae[[paste0("n_", i)]] <- reactable::colDef(name = "n")
+  #   col_defs_ae[[paste0("prop_", i)]] <- reactable::colDef(name = "(%)")
+  #   
+  #   col_group_defs_ae <- append(
+  #     col_group_defs_ae,
+  #     list(reactable::colGroup(
+  #       name = ae_specific_outdata$group[i],
+  #       columns = c(paste0("n_", i), paste0("prop_", i))
+  #     ))
+  #   )
+  # }
+  
+  # ----------------------------------------- #
+  #   build interactive disposition table     #
+  # ----------------------------------------- #
+  # Define Column
+  # col_defs <- list()
+  # for (sl_name in names(tbl_sl)) {
+  #   if (startsWith(sl_name, "n_")) {
+  #     col_defs[[sl_name]] <- reactable::colDef(name = "n")
+  #   } else if (startsWith(sl_name, "p_")) {
+  #     col_defs[[sl_name]] <- reactable::colDef(name = "(%)")
+  #   } else {
+  #     col_defs[[sl_name]] <- reactable::colDef(name = " ")
+  #   }
+  # }
+  
+  # Define Column Group
+  # col_group_defs <- list()
+  # for (i in 1:length(x_sl$group_label)) {
+  #   group <- levels(x_sl$group_label)[i]
+  #   col_group_defs <- append(
+  #     col_group_defs,
+  #     list(reactable::colGroup(
+  #       name = group,
+  #       columns = c(paste0("n_", i), paste0("p_", i))
+  #     ))
+  #   )
+  # }
+  # if (display_total == TRUE) {
+  #   col_group_defs <- append(
+  #     col_group_defs,
+  #     list(reactable::colGroup(
+  #       name = "Total",
+  #       columns = c("n_9999", "p_9999")
+  #     ))
+  #   )
+  # }
+  
+  details = function(index) {
+    dcsreas <- stringr::str_trim(tolower(tbl_sl$name[index]))
+    if ( dcsreas %in% c("adverse event") &
+         !is.na(tbl_sl$name[index])
+    ) {
+      if (stringr::str_trim(tolower(tbl_sl$var_label[index]))=="trial disposition") {
+        var <- metadata_sl$parameter[['disposition']]$var
+      }
+      if (stringr::str_trim(tolower(tbl_sl$var_label[index]))=="participant ptudy medication disposition"){
+        var <- metadata_sl$parameter[['medical-disposition']]$var
+      }
+      # get the index of the AE subgroup variable by the index in the baseline char table
+      usubjids <- x_sl$meta$data_population |> dplyr::filter(tolower(DCSREAS)==dcsreas & tolower(!!as.symbol(var))=="discontinued") |> dplyr::pull(USUBJID)
+      subj_list <- metadata_sl$data_population |> dplyr::filter(USUBJID %in% usubjids)
+      subj_list |>
+        reactable::reactable(
+          details = subj_details
+        )
+    } 
+  }
+  
+  subj_details <- function(index) {
+    usubjid <- subj_list$USUBJID[index]
+    sub_ae_listing <- ae_listing_outdata$ae_listing |> dplyr::filter(Unique_Participant_ID %in% usubjid)
+    sub_ae_listing |> 
+      reactable::reactable(
+      )
+  }
+  
+  reactable::reactable(
+    tbl_sl,
+    groupBy = "var_label",
+    width = width,
+    columns = col_defs,
+    columnGroups = col_group_defs,
+    details = details
+  )
+}

From 5cf3f56553223d41cff49926c4c6cc4ec0403b3c Mon Sep 17 00:00:00 2001
From: niup0 <poyao.niu@merck.com>
Date: Wed, 25 Sep 2024 15:23:47 -0400
Subject: [PATCH 02/10] fix column definitions

---
 R/react_disposition.R | 64 +++++++++++++++++++++----------------------
 1 file changed, 32 insertions(+), 32 deletions(-)

diff --git a/R/react_disposition.R b/R/react_disposition.R
index a1bb45d..190b1f8 100644
--- a/R/react_disposition.R
+++ b/R/react_disposition.R
@@ -164,38 +164,38 @@ react_disposition <- function(
   #   build interactive disposition table     #
   # ----------------------------------------- #
   # Define Column
-  # col_defs <- list()
-  # for (sl_name in names(tbl_sl)) {
-  #   if (startsWith(sl_name, "n_")) {
-  #     col_defs[[sl_name]] <- reactable::colDef(name = "n")
-  #   } else if (startsWith(sl_name, "p_")) {
-  #     col_defs[[sl_name]] <- reactable::colDef(name = "(%)")
-  #   } else {
-  #     col_defs[[sl_name]] <- reactable::colDef(name = " ")
-  #   }
-  # }
-  
+  col_defs <- list()
+  for (sl_name in names(tbl_sl)) {
+    if (startsWith(sl_name, "n_")) {
+      col_defs[[sl_name]] <- reactable::colDef(name = "n")
+    } else if (startsWith(sl_name, "p_")) {
+      col_defs[[sl_name]] <- reactable::colDef(name = "(%)")
+    } else {
+      col_defs[[sl_name]] <- reactable::colDef(name = " ")
+    }
+  }
+
   # Define Column Group
-  # col_group_defs <- list()
-  # for (i in 1:length(x_sl$group_label)) {
-  #   group <- levels(x_sl$group_label)[i]
-  #   col_group_defs <- append(
-  #     col_group_defs,
-  #     list(reactable::colGroup(
-  #       name = group,
-  #       columns = c(paste0("n_", i), paste0("p_", i))
-  #     ))
-  #   )
-  # }
-  # if (display_total == TRUE) {
-  #   col_group_defs <- append(
-  #     col_group_defs,
-  #     list(reactable::colGroup(
-  #       name = "Total",
-  #       columns = c("n_9999", "p_9999")
-  #     ))
-  #   )
-  # }
+  col_group_defs <- list()
+  for (i in 1:length(x_sl$group_label)) {
+    group <- levels(x_sl$group_label)[i]
+    col_group_defs <- append(
+      col_group_defs,
+      list(reactable::colGroup(
+        name = group,
+        columns = c(paste0("n_", i), paste0("p_", i))
+      ))
+    )
+  }
+  if (display_total == TRUE) {
+    col_group_defs <- append(
+      col_group_defs,
+      list(reactable::colGroup(
+        name = "Total",
+        columns = c("n_9999", "p_9999")
+      ))
+    )
+  }
   
   details = function(index) {
     dcsreas <- stringr::str_trim(tolower(tbl_sl$name[index]))
@@ -208,7 +208,7 @@ react_disposition <- function(
       if (stringr::str_trim(tolower(tbl_sl$var_label[index]))=="participant ptudy medication disposition"){
         var <- metadata_sl$parameter[['medical-disposition']]$var
       }
-      # get the index of the AE subgroup variable by the index in the baseline char table
+      # get dicontinued subject list
       usubjids <- x_sl$meta$data_population |> dplyr::filter(tolower(DCSREAS)==dcsreas & tolower(!!as.symbol(var))=="discontinued") |> dplyr::pull(USUBJID)
       subj_list <- metadata_sl$data_population |> dplyr::filter(USUBJID %in% usubjids)
       subj_list |>

From 01e74a4eb23ad9a7cfadeb65553e8e771cef58ff Mon Sep 17 00:00:00 2001
From: niup0 <poyao.niu@merck.com>
Date: Wed, 25 Sep 2024 16:37:12 -0400
Subject: [PATCH 03/10] bug fix.

---
 R/react_disposition.R | 18 ++++++++----------
 1 file changed, 8 insertions(+), 10 deletions(-)

diff --git a/R/react_disposition.R b/R/react_disposition.R
index 190b1f8..64a14cb 100644
--- a/R/react_disposition.R
+++ b/R/react_disposition.R
@@ -52,8 +52,8 @@ react_disposition <- function(
     metadata_sl,
     metadata_ae,
     analysis = 'disp',
-    population = meta$plan[meta$plan$analysis==analysis,]$population,
-    sl_parameter = paste(meta$plan[meta$plan$analysis==analysis,]$parameter, collapse = ";"),
+    population = metadata_sl$plan[metadata_sl$plan$analysis==analysis,]$population,
+    sl_parameter = paste(metadata_sl$plan[metadata_sl$plan$analysis==analysis,]$parameter, collapse = ";"),
     # observation = "wk12",
     display_total = TRUE,
     #ae_subgroup = c("gender", "race"),
@@ -199,9 +199,7 @@ react_disposition <- function(
   
   details = function(index) {
     dcsreas <- stringr::str_trim(tolower(tbl_sl$name[index]))
-    if ( dcsreas %in% c("adverse event") &
-         !is.na(tbl_sl$name[index])
-    ) {
+    if ( dcsreas %in% c("adverse event") & !is.na(tbl_sl$name[index]) ) {
       if (stringr::str_trim(tolower(tbl_sl$var_label[index]))=="trial disposition") {
         var <- metadata_sl$parameter[['disposition']]$var
       }
@@ -212,20 +210,20 @@ react_disposition <- function(
       usubjids <- x_sl$meta$data_population |> dplyr::filter(tolower(DCSREAS)==dcsreas & tolower(!!as.symbol(var))=="discontinued") |> dplyr::pull(USUBJID)
       subj_list <- metadata_sl$data_population |> dplyr::filter(USUBJID %in% usubjids)
       subj_list |>
-        reactable::reactable(
-          details = subj_details
-        )
+      reactable::reactable(
+        details = subj_details
+      )
     } 
   }
   
   subj_details <- function(index) {
     usubjid <- subj_list$USUBJID[index]
     sub_ae_listing <- ae_listing_outdata$ae_listing |> dplyr::filter(Unique_Participant_ID %in% usubjid)
-    sub_ae_listing |> 
+    sub_ae_listing |>
       reactable::reactable(
       )
   }
-  
+  subj_list <- data.frame()
   reactable::reactable(
     tbl_sl,
     groupBy = "var_label",

From e581c144c637f8098d688c5d787df10f5e2d7591 Mon Sep 17 00:00:00 2001
From: niup0 <poyao.niu@merck.com>
Date: Mon, 30 Sep 2024 11:17:55 -0400
Subject: [PATCH 04/10] AE list under each subject.

---
 R/react_disposition.R | 19 +++++++++----------
 1 file changed, 9 insertions(+), 10 deletions(-)

diff --git a/R/react_disposition.R b/R/react_disposition.R
index 64a14cb..3aaec26 100644
--- a/R/react_disposition.R
+++ b/R/react_disposition.R
@@ -211,19 +211,18 @@ react_disposition <- function(
       subj_list <- metadata_sl$data_population |> dplyr::filter(USUBJID %in% usubjids)
       subj_list |>
       reactable::reactable(
-        details = subj_details
+        details = function(index) {
+          usubjid <- subj_list$USUBJID[index]
+          sub_ae_listing <- ae_listing_outdata$ae_listing |> dplyr::filter(Unique_Participant_ID %in% usubjid)
+          sub_ae_listing |>
+            reactable::reactable(
+            )
+        }
       )
     } 
   }
-  
-  subj_details <- function(index) {
-    usubjid <- subj_list$USUBJID[index]
-    sub_ae_listing <- ae_listing_outdata$ae_listing |> dplyr::filter(Unique_Participant_ID %in% usubjid)
-    sub_ae_listing |>
-      reactable::reactable(
-      )
-  }
-  subj_list <- data.frame()
+
+
   reactable::reactable(
     tbl_sl,
     groupBy = "var_label",

From 22bec87e2c0555ff0b8a2fb9a4959e25b84db959 Mon Sep 17 00:00:00 2001
From: niup0 <poyao.niu@merck.com>
Date: Wed, 30 Oct 2024 18:58:58 -0400
Subject: [PATCH 05/10] Remove dplyr use. Define columns for subject & AE
 listing. Subjects grouped by treatment. Added filter to subect list.

---
 R/react_disposition.R | 107 +++++++++++-------------------------------
 1 file changed, 27 insertions(+), 80 deletions(-)

diff --git a/R/react_disposition.R b/R/react_disposition.R
index 3aaec26..ae393e8 100644
--- a/R/react_disposition.R
+++ b/R/react_disposition.R
@@ -82,87 +82,19 @@ react_disposition <- function(
   
   tbl_sl <- x_sl$tbl
   tbl_sl$var_label[tbl_sl$name == "Participants in population"] <- "Participants in population"
-  
-  # ----------------------------------------- #
-  #   prepare the AE subgroup table numbers   #
-  # ----------------------------------------- #
-  # get the variable name of the subgroup
-  # ae_subgrp_var <- NULL
-  # ae_subgrp_label <- NULL
-  # for (x_subgrp in ae_subgroup) {
-  #   if (length(metalite::collect_adam_mapping(metadata_sl, x_subgrp)$vargroup) > 0) {
-  #     ae_subgrp_var <- c(ae_subgrp_var, metalite::collect_adam_mapping(metadata_sl, x_subgrp)$vargroup)
-  #   } else {
-  #     ae_subgrp_var <- c(ae_subgrp_var, metalite::collect_adam_mapping(metadata_sl, x_subgrp)$var)
-  #   }
-  #   ae_subgrp_label <- c(ae_subgrp_label, metalite::collect_adam_mapping(metadata_sl, x_subgrp)$label)
-  # }
-  
-  # get the AE subgroup tables
-  # tbl_ae <- list()
-  # group_ae <- list()
-  # 
-  # for (y_subgrp in ae_subgrp_var) {
-  #   tbl_ae_temp <- metalite.ae::prepare_ae_specific_subgroup(
-  #     metadata_ae,
-  #     population = population,
-  #     observation = observation,
-  #     parameter = ae_specific,
-  #     subgroup_var = y_subgrp,
-  #     display_subgroup_total = FALSE # total display for subgroup is not needed
-  #   ) |>
-  #     format_ae_specific_subgroup()
-  #   
-  #   tbl_ae <- c(tbl_ae, list(tbl_ae_temp$tbl))
-  #   # get group labels for AE analysis
-  #   group_ae <- c(group_ae, list(tbl_ae_temp$group))
-  #   # Note: Need to confirm whether treatment total can be displayed in ae subgroup
-  #   # if (display_total == TRUE){
-  #   #   group_ae <- c(group_ae, list(tbl_ae_temp$group))
-  #   # } else {
-  #   #   group_ae <- c(group_ae, list(tbl_ae_temp$group[!(tbl_ae_temp$group %in% "total")]))
-  #   # }
-  # }
-  
-  # get the AE specific
-  # ae_listing_outdata <- metalite.ae::prepare_ae_listing(
-  #   metadata_ae,
-  #   analysis = 'ae_listing',
-  #   population = population,
-  #   observation = observation,
-  #   parameter = 'any'
-  # ) |>
-  #   forestly:::format_ae_listing(display = display_sl)
+ 
+  # get AE listing
   
   ae_listing_outdata <- metalite.ae::prepare_ae_specific(metadata_ae, "apat", "wk12", "any") |>
     forestly:::collect_ae_listing(
       c(
-        "USUBJID", "SEX", "RACE", "AGE", "ASTDY", "AESEV", "AESER",
+        "USUBJID", "SEX", "RACE", "AGE", "ASTDT", "ASTDY", "AESEV", "AESER",
         "AEREL", "AEACN", "AEOUT", "SITEID", "ADURN", "ADURU", "AOCCPFL"
       )
     ) |>
     forestly:::format_ae_listing()
   
-  # Define Column and Column Group for AE specific
-  # col_defs_ae <- list()
-  # col_group_defs_ae <- list()
-  # col_defs_ae[["name"]] <- reactable::colDef(name = " ")
-  # for (i in 1:length(ae_specific_outdata$group)) {
-  #   col_defs_ae[[paste0("n_", i)]] <- reactable::colDef(name = "n")
-  #   col_defs_ae[[paste0("prop_", i)]] <- reactable::colDef(name = "(%)")
-  #   
-  #   col_group_defs_ae <- append(
-  #     col_group_defs_ae,
-  #     list(reactable::colGroup(
-  #       name = ae_specific_outdata$group[i],
-  #       columns = c(paste0("n_", i), paste0("prop_", i))
-  #     ))
-  #   )
-  # }
   
-  # ----------------------------------------- #
-  #   build interactive disposition table     #
-  # ----------------------------------------- #
   # Define Column
   col_defs <- list()
   for (sl_name in names(tbl_sl)) {
@@ -197,7 +129,20 @@ react_disposition <- function(
     )
   }
   
-  details = function(index) {
+  # Define columns for subject list
+  sl_selected <- toupper(c( 'trt01a', 'usubjid', 'siteid', 'subjid', 'sex', 'age', 'weightbl'))
+  sl_sel_names <- c('Treatment', 'Unique Subjet ID', 'Site', 'Subject ID', 'Sex', 'Age (Year)', 'Weight (kg)')
+  sl_col_def <- list()
+  for (i in 1:length(sl_selected)) sl_col_def[[sl_selected[i]]] <- reactable::colDef(sl_sel_names[i])
+  
+  # Define columns for AE list
+  ae_selected <- c('SOC_Name', 'ASTDT', 'Relative_Day_of_Onset', 'Adverse_Event', 'Duration', 'Intensity', 'Serious', 'Related', 'Action_Taken', 'Outcome')
+  ae_sel_names <- c('SOC', 'Onset Date', 'Relative Day of Onset', 'AE', 'Duraion', 'Intensity', 'Serious', 'Related', 'Action Taken', 'Outcome')
+  ae_col_def <- list()
+  for (i in 1:length(ae_selected)) ae_col_def[[ae_selected[i]]] <- reactable::colDef(ae_sel_names[i])
+  
+  trt_grp <- 'trt01a'
+  details <- function(index) {
     dcsreas <- stringr::str_trim(tolower(tbl_sl$name[index]))
     if ( dcsreas %in% c("adverse event") & !is.na(tbl_sl$name[index]) ) {
       if (stringr::str_trim(tolower(tbl_sl$var_label[index]))=="trial disposition") {
@@ -206,17 +151,19 @@ react_disposition <- function(
       if (stringr::str_trim(tolower(tbl_sl$var_label[index]))=="participant ptudy medication disposition"){
         var <- metadata_sl$parameter[['medical-disposition']]$var
       }
-      # get dicontinued subject list
-      usubjids <- x_sl$meta$data_population |> dplyr::filter(tolower(DCSREAS)==dcsreas & tolower(!!as.symbol(var))=="discontinued") |> dplyr::pull(USUBJID)
-      subj_list <- metadata_sl$data_population |> dplyr::filter(USUBJID %in% usubjids)
+      # get discontinued subject list
+      usubjids <- x_sl$meta$data_population$USUBJID |> subset(tolower(x_sl$meta$data_population$DCSREAS)==dcsreas &  tolower(x_sl$meta$data_population[[var]])=="discontinued")
+      subj_list <- metadata_sl$data_population |> subset(subset = metadata_sl$data_population$USUBJID %in% usubjids,
+                                                         select = sl_selected )
       subj_list |>
-      reactable::reactable(
+      reactable::reactable(filterable = T, defaultExpanded = F, striped = T, groupBy = toupper(trt_grp),
+        columns = sl_col_def,
         details = function(index) {
           usubjid <- subj_list$USUBJID[index]
-          sub_ae_listing <- ae_listing_outdata$ae_listing |> dplyr::filter(Unique_Participant_ID %in% usubjid)
-          sub_ae_listing |>
-            reactable::reactable(
-            )
+          # get AE list of a subject
+          sub_ae_listing <- ae_listing_outdata$ae_listing |> subset(subset = ae_listing_outdata$ae_listing$Unique_Participant_ID %in% usubjid, 
+                                                                    select = ae_selected)
+          sub_ae_listing |> reactable::reactable(striped = F, columns = ae_col_def, defaultExpanded = F) 
         }
       )
     } 

From 55342addd364eb4ce3dabbdb013dfdd13a320cfe Mon Sep 17 00:00:00 2001
From: niup0 <poyao.niu@merck.com>
Date: Wed, 30 Oct 2024 19:21:19 -0400
Subject: [PATCH 06/10] Added subject listing for each reason of
 discontination.

---
 R/react_disposition.R | 23 +++++++++--------------
 1 file changed, 9 insertions(+), 14 deletions(-)

diff --git a/R/react_disposition.R b/R/react_disposition.R
index ae393e8..d910b2b 100644
--- a/R/react_disposition.R
+++ b/R/react_disposition.R
@@ -24,15 +24,10 @@
 #'   which builds the AE subgroup specific table
 #' @param population A character value of population term name.
 #'   The term name is used as key to link information.
-#' @param observation A character value of observation term name.
-#'   The term name is used as key to link information.
 #' @param display_total Display total column or not.
 #' @param sl_parameter A character value of parameter term name for
 #'   the baseline characteristic table.
 #'   The term name is used as key to link information.
-#' @param ae_subgroup A vector of strubf to specify the subgroups
-#'   in the AE subgroup specific table.
-#' @param ae_specific A string specifying the AE specific category.
 #' @param width A numeric value of width of the table in pixels.
 #'
 #' @return An reactable combing both baseline characteristic table
@@ -54,10 +49,7 @@ react_disposition <- function(
     analysis = 'disp',
     population = metadata_sl$plan[metadata_sl$plan$analysis==analysis,]$population,
     sl_parameter = paste(metadata_sl$plan[metadata_sl$plan$analysis==analysis,]$parameter, collapse = ";"),
-    # observation = "wk12",
     display_total = TRUE,
-    #ae_subgroup = c("gender", "race"),
-    #ae_specific = "rel",
     width = 1200) {
   # ----------------------------------------- #
   #   total setting                           #
@@ -141,10 +133,10 @@ react_disposition <- function(
   ae_col_def <- list()
   for (i in 1:length(ae_selected)) ae_col_def[[ae_selected[i]]] <- reactable::colDef(ae_sel_names[i])
   
-  trt_grp <- 'trt01a'
+  trt_grp <-  toupper('trt01a')
   details <- function(index) {
     dcsreas <- stringr::str_trim(tolower(tbl_sl$name[index]))
-    if ( dcsreas %in% c("adverse event") & !is.na(tbl_sl$name[index]) ) {
+    if (!is.na(tbl_sl$name[index]) & !(dcsreas %in% c("participants in population", "discontinued", "participants ongoing", "completed"))) {
       if (stringr::str_trim(tolower(tbl_sl$var_label[index]))=="trial disposition") {
         var <- metadata_sl$parameter[['disposition']]$var
       }
@@ -156,14 +148,17 @@ react_disposition <- function(
       subj_list <- metadata_sl$data_population |> subset(subset = metadata_sl$data_population$USUBJID %in% usubjids,
                                                          select = sl_selected )
       subj_list |>
-      reactable::reactable(filterable = T, defaultExpanded = F, striped = T, groupBy = toupper(trt_grp),
+      reactable::reactable(filterable = T, defaultExpanded = F, striped = T, groupBy =trt_grp,
         columns = sl_col_def,
         details = function(index) {
           usubjid <- subj_list$USUBJID[index]
           # get AE list of a subject
-          sub_ae_listing <- ae_listing_outdata$ae_listing |> subset(subset = ae_listing_outdata$ae_listing$Unique_Participant_ID %in% usubjid, 
-                                                                    select = ae_selected)
-          sub_ae_listing |> reactable::reactable(striped = F, columns = ae_col_def, defaultExpanded = F) 
+          if ( dcsreas %in% c("adverse event")){
+            sub_ae_listing <- ae_listing_outdata$ae_listing |> subset(subset = ae_listing_outdata$ae_listing$Unique_Participant_ID %in% usubjid, 
+                                                                      select = ae_selected)
+            sub_ae_listing |> reactable::reactable(striped = F, columns = ae_col_def, defaultExpanded = F) 
+          }
+          
         }
       )
     } 

From e78ffe7c3a70b381f06c2bf90595ac9bdb56c18b Mon Sep 17 00:00:00 2001
From: niup0 <poyao.niu@merck.com>
Date: Wed, 30 Oct 2024 19:49:14 -0400
Subject: [PATCH 07/10] typo fix.

---
 R/react_disposition.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/react_disposition.R b/R/react_disposition.R
index d910b2b..ab3abdc 100644
--- a/R/react_disposition.R
+++ b/R/react_disposition.R
@@ -140,7 +140,7 @@ react_disposition <- function(
       if (stringr::str_trim(tolower(tbl_sl$var_label[index]))=="trial disposition") {
         var <- metadata_sl$parameter[['disposition']]$var
       }
-      if (stringr::str_trim(tolower(tbl_sl$var_label[index]))=="participant ptudy medication disposition"){
+      if (stringr::str_trim(tolower(tbl_sl$var_label[index]))=="participant study medication disposition"){
         var <- metadata_sl$parameter[['medical-disposition']]$var
       }
       # get discontinued subject list

From 5d1f54ad3c158563b807d21b09cde127e1bf9107 Mon Sep 17 00:00:00 2001
From: niup0 <poyao.niu@merck.com>
Date: Thu, 31 Oct 2024 17:37:37 -0400
Subject: [PATCH 08/10] Build package.

---
 NAMESPACE                |  1 +
 R/react_disposition.R    |  1 +
 man/react_disposition.Rd | 51 ++++++++++++++++++++++++++++++++++++++++
 3 files changed, 53 insertions(+)
 create mode 100644 man/react_disposition.Rd

diff --git a/NAMESPACE b/NAMESPACE
index 51c180a..c6b0112 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -18,6 +18,7 @@ export(prepare_exp_duration)
 export(prepare_sl_summary)
 export(prepare_trt_compliance)
 export(react_base_char)
+export(react_disposition)
 export(rtf_base_char)
 export(rtf_base_char_subgroup)
 export(rtf_disposition)
diff --git a/R/react_disposition.R b/R/react_disposition.R
index ab3abdc..94f30c7 100644
--- a/R/react_disposition.R
+++ b/R/react_disposition.R
@@ -167,6 +167,7 @@ react_disposition <- function(
 
   reactable::reactable(
     tbl_sl,
+    sortable = F,
     groupBy = "var_label",
     width = width,
     columns = col_defs,
diff --git a/man/react_disposition.Rd b/man/react_disposition.Rd
new file mode 100644
index 0000000..7d7b396
--- /dev/null
+++ b/man/react_disposition.Rd
@@ -0,0 +1,51 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/react_disposition.R
+\name{react_disposition}
+\alias{react_disposition}
+\title{Display interactive disposition tables with AE subgroup analysis}
+\usage{
+react_disposition(
+  metadata_sl,
+  metadata_ae,
+  analysis = "disp",
+  population = metadata_sl$plan[metadata_sl$plan$analysis == analysis, ]$population,
+  sl_parameter = paste(metadata_sl$plan[metadata_sl$plan$analysis == analysis,
+    ]$parameter, collapse = ";"),
+  display_total = TRUE,
+  width = 1200
+)
+}
+\arguments{
+\item{metadata_sl}{A metadata created by \link{metalite},
+which builds the baseline characteristic table}
+
+\item{metadata_ae}{A metadata created by \link{metalite},
+which builds the AE subgroup specific table}
+
+\item{population}{A character value of population term name.
+The term name is used as key to link information.}
+
+\item{sl_parameter}{A character value of parameter term name for
+the baseline characteristic table.
+The term name is used as key to link information.}
+
+\item{display_total}{Display total column or not.}
+
+\item{width}{A numeric value of width of the table in pixels.}
+}
+\value{
+An reactable combing both baseline characteristic table
+and AE subgroup specific tables.
+}
+\description{
+Display interactive disposition tables with AE subgroup analysis
+}
+\examples{
+if (interactive()) {
+  react_disposition(
+    metadata_sl = meta_sl_example(),
+    metadata_ae = metalite.ae::meta_ae_example(),
+    width = 1200
+  )
+}
+}

From 67298ff705eafd74cf627aad8e47ff72a0f42c92 Mon Sep 17 00:00:00 2001
From: "Zhao, Yujie" <yujie.zhao@merck.com>
Date: Mon, 4 Nov 2024 10:31:36 -0500
Subject: [PATCH 09/10] update Rd file by adding `@param analysis`

---
 R/react_disposition.R    | 1 +
 man/react_disposition.Rd | 2 ++
 2 files changed, 3 insertions(+)

diff --git a/R/react_disposition.R b/R/react_disposition.R
index 94f30c7..e789ae1 100644
--- a/R/react_disposition.R
+++ b/R/react_disposition.R
@@ -22,6 +22,7 @@
 #'   which builds the baseline characteristic table
 #' @param metadata_ae A metadata created by [metalite],
 #'   which builds the AE subgroup specific table
+#' @param analysis The analysis label provided in \code{metadata_sl}.
 #' @param population A character value of population term name.
 #'   The term name is used as key to link information.
 #' @param display_total Display total column or not.
diff --git a/man/react_disposition.Rd b/man/react_disposition.Rd
index 7d7b396..79013a1 100644
--- a/man/react_disposition.Rd
+++ b/man/react_disposition.Rd
@@ -22,6 +22,8 @@ which builds the baseline characteristic table}
 \item{metadata_ae}{A metadata created by \link{metalite},
 which builds the AE subgroup specific table}
 
+\item{analysis}{The analysis label provided in \code{metadata_sl}.}
+
 \item{population}{A character value of population term name.
 The term name is used as key to link information.}
 

From a14fd030ee9db541541bdecc3391a006a30c83a8 Mon Sep 17 00:00:00 2001
From: "Zhao, Yujie" <yujie.zhao@merck.com>
Date: Mon, 4 Nov 2024 10:31:50 -0500
Subject: [PATCH 10/10] add forestly to DESCRIPTION

---
 DESCRIPTION | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 4e986b7..e24d36d 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -15,6 +15,7 @@ Imports:
     glue,
     metalite,
     metalite.ae,
+    forestly,
     r2rtf,
     reactable,
     stringr,
@@ -27,5 +28,5 @@ Suggests:
 VignetteBuilder: knitr
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 Config/testthat/edition: 3