# 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 analysis The analysis label provided in \code{metadata_sl}.
#' @param trtvar A character that indicate variable for the treatment group.
#' @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.
#' @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 sl_col_selected A character vector of variable which will be shown in the participant detail.
#' @param sl_col_names A character vector for the columns names of the participant detail. Same length as sl_col_selected.
#' @param ae_observation The meta parameter of the observation in adverse event listing.
#' @param ae_population The meta parameter of the population in adverse event listing.
#' @param ae_parameter A character value of the parameter in adverse event listing.
#' @param ae_col_selected A character vector of variable which will be shown in the AE detail.
#' @param ae_col_names A character vector for the columns names of the AE detail. Same length as ae_col_selected.
#' @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()) {
#'   sl_plan <- metalite::plan(
#'     analysis = "disp",
#'     population = "apat",
#'     observation = "apat",
#'     parameter = "disposition;medical-disposition"
#'   )
#'
#'   metadata_sl <- metalite::meta_adam(
#'     observation = metalite_sl_adsl,
#'     population = metalite_sl_adsl
#'   ) |>
#'     metalite::define_plan(sl_plan) |>
#'     metalite::define_population(
#'       name = "apat",
#'       group = "TRTA",
#'       subset = SAFFL == "Y"
#'     ) |>
#'     metalite::define_parameter(
#'       name = "disposition",
#'       var = "EOSSTT",
#'       label = "Trial Disposition",
#'       var_lower = "DCSREAS"
#'     ) |>
#'     metalite::define_parameter(
#'       name = "medical-disposition",
#'       var = "EOTSTT",
#'       label = "Participant Study Medication Disposition",
#'       var_lower = "DCTREAS"
#'     ) |>
#'     metalite::define_analysis(
#'       name = "disp",
#'       title = "Disposition of Participant"
#'     ) |>
#'     metalite::meta_build()
#'
#'   analysis_plan <- metalite::plan(
#'     analysis = "ae_specific",
#'     population = "apat",
#'     observation = "wk12",
#'     parameter = "any"
#'   )
#'
#'   metadata_ae <- metalite::meta_adam(
#'     observation = metalite_sl_adae,
#'     population = metalite_sl_adsl
#'   ) |>
#'     metalite::define_plan(analysis_plan) |>
#'     metalite::define_population(
#'       name = "apat",
#'       group = "TRTA",
#'       subset = SAFFL == "Y",
#'       label = "All Participants as Treated"
#'     ) |>
#'     metalite::define_observation(
#'       name = "wk12",
#'       group = "TRTA",
#'       subset = SAFFL == "Y",
#'       label = "Weeks 0 to 12"
#'     ) |>
#'     metalite::define_parameter(
#'       name = "any",
#'       term1 = "",
#'       term2 = "",
#'       var = "AEDECOD",
#'       soc = "AEBODSYS",
#'       label = "All AEs"
#'     ) |>
#'     metalite::define_analysis(
#'       name = "ae_specific",
#'       title = "Participants With Adverse Events"
#'     ) |>
#'     metalite::meta_build()
#'
#'   react_disposition(
#'     metadata_sl = metadata_sl,
#'     metadata_ae = metadata_ae
#'   )
#' }
react_disposition <- function(
  metadata_sl,
  metadata_ae,
  analysis = "disp",
  trtvar = metalite::collect_adam_mapping(metadata_sl, population)$group,
  population = metadata_sl$plan$population[metadata_sl$plan$analysis == analysis],
  sl_parameter = paste(metadata_sl$plan$parameter[metadata_sl$plan$analysis == analysis], collapse = ";"),
  sl_col_selected = c("siteid", "subjid", "sex", "age", "weightbl"),
  sl_col_names = c("Site", "Subject ID", "Sex", "Age (Year)", "Weight (kg)"),
  ae_observation = "wk12",
  ae_population = population,
  ae_parameter = "any",
  ae_col_selected = c("AESOC", "ASTDT", "AENDT", "AETERM", "duration", "AESEV", "AESER", "related", "AEACN", "AEOUT"),
  ae_col_names = c("SOC", "Onset Date", "End Date", "AE", "Duraion", "Intensity", "Serious", "Related", "Action Taken", "Outcome"),
  display_total = TRUE,
  width = 1200
) {
  # ----------------------------------------- #
  #   total setting                           #
  # ----------------------------------------- #

  if (display_total == TRUE) {
    display_sl <- c("n", "prop", "total")
  } else {
    display_sl <- c("n", "prop")
  }

  # ----------------------------------------- #
  #   prepare the disposition 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"

  # 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")
      ))
    )
  }

  # Define columns for subject list
  sl_col_selected <- toupper(sl_col_selected)
  if (!(toupper(trtvar) %in% sl_col_selected)) {
    sl_col_selected <- c(toupper(trtvar), sl_col_selected)
    sl_col_names <- c("Treatment", sl_col_names)
  }
  u_sl_col_selected <- unique(c("USUBJID", sl_col_selected))
  if (!length(sl_col_names) == length(sl_col_selected)) {
    message(paste(
      "`sl_col_names` and `sl_col_selected` should have the same length.",
      "`sl_col_selected` will be used as column names."
    ))
    sl_col_names <- sl_col_selected
  }
  sl_col_def <- list()
  for (i in 1:length(sl_col_selected)) sl_col_def[[sl_col_selected[i]]] <- reactable::colDef(sl_col_names[i])

  # ----------------------------------------- #
  #   get AE listing                          #
  # ----------------------------------------- #
  ae_list <- metalite::collect_observation_record(metadata_ae, ae_population, ae_observation, parameter = ae_parameter, var = names(metadata_ae$data_observation))

  # Define columns for AE list
  if (!length(ae_col_names) == length(ae_col_selected)) {
    message(paste(
      "`ae_col_names` and `ae_col_selected` should have the same length.",
      "`ae_col_selected` will be used as column names."
    ))
    ae_col_names <- ae_col_selected
  }
  ae_col_def <- list()
  for (i in 1:length(ae_col_selected)) ae_col_def[[ae_col_selected[i]]] <- reactable::colDef(ae_col_names[i])

  # ----------------------------------------- #
  #   making react table                      #
  # ----------------------------------------- #
  trt_grp <- toupper(trtvar)
  # show participant details when category not in "participants in population", "discontinued", "participants ongoing", "complete"
  details <- function(index) {
    dcsreas <- stringr::str_trim(tolower(tbl_sl$name[index]))
    if (!is.na(tbl_sl$name[index]) & !(dcsreas %in% c("participants in population", "discontinued", "participants ongoing", "complete"))) {
      if (stringr::str_trim(tolower(tbl_sl$var_label[index])) == "trial disposition") {
        var <- metadata_sl$parameter[["disposition"]]$var
        var_lower <- metadata_sl$parameter[["disposition"]]$var_lower
      }
      if (stringr::str_trim(tolower(tbl_sl$var_label[index])) == "participant study medication disposition") {
        var <- metadata_sl$parameter[["medical-disposition"]]$var
        var_lower <- metadata_sl$parameter[["medical-disposition"]]$var_lower
      }
      # get discontinued subject list
      data_sl <- metalite::collect_population_record(metadata_sl, population, var = names(metadata_sl$data_population))
      usubjids <- data_sl$USUBJID |>
        subset(tolower(data_sl[[var_lower]]) == dcsreas & tolower(data_sl[[var]]) == "discontinued")
      subj_list <- data_sl |> subset(
        subset = data_sl$USUBJID %in% usubjids,
        select = u_sl_col_selected
      )

      subj_list[, sl_col_selected] |>
        reactable::reactable(
          filterable = TRUE, defaultExpanded = FALSE, striped = TRUE, groupBy = trt_grp,
          columns = sl_col_def,
          details = function(index) {
            usubjid <- subj_list$USUBJID[index]
            # get AE list of a subject if discontinued because of AE
            if ((var == "EOTSTT" && dcsreas %in% c("adverse event")) | (var == "EOSSTT" && dcsreas %in% c("other"))) {
              sub_ae_listing <- ae_list |> subset(
                subset = ae_list$USUBJID %in% usubjid,
                select = ae_col_selected
              )
              sub_ae_listing |> reactable::reactable(striped = FALSE, columns = ae_col_def, defaultExpanded = FALSE, filterable = TRUE)
            }
          }
        )
    }
  }


  reactable::reactable(
    tbl_sl,
    sortable = FALSE,
    groupBy = "var_label",
    width = width,
    columns = col_defs,
    columnGroups = col_group_defs,
    details = details
  )
}
