#' Simulate a kidney disease `hce` dataset
#'
#' Simulate a kidney disease `hce` dataset, capturing eGFR (Estimated Glomerular Filtration Rate) progression over time, along with 
#' a competing and dependent terminal event: KFRT (Kidney Failure Replacement Therapy)
#' 
#' @param n sample size in the active treatment group.
#' @param CM_A annualized eGFR slope in the active group.
#' @param CM_P annualized eGFR slope in the control group.
#' @param n0 sample size in the control treatment group.
#' @param TTE_A event rate per year in the active group for KFRT.
#' @param TTE_P event rate per year in the placebo group for KFRT. 
#' @param fixedfy length of follow-up in years.
#' @param Emin lower limit of eGFR at baseline.
#' @param Emax upper limit of eGFR at baseline.
#' @param sigma within-patient standard deviation.
#' @param Sigma between-patient standard deviation.
#' @param m number of equidistant visits.
#' @param theta coefficient of dependence of eGFR values and the risk of KFRT.
#' @param phi coefficient of proportionality (between 0 and 1) of the treatment effect. The case of 0 corresponds to the uniform treatment effect.
#' @param two_meas determines whether to use duplicate measurements at baseline and/or at `fixedfy`. The default is to use a single measurement.
#' @param df_sigma degrees of freedom for the measurement error distribution. The default `Inf` gives normal measurement errors; must be more than 2.
#' @details
#' The default setting is `TTE_A = TTE_P` because, conditional on eGFR level,
#' the treatment effect does not influence the event rate of KFRT. In this model,
#' the effect of treatment on KFRT operates entirely through its impact on eGFR decline.
#'
#' Let `CM_A` and `CM_P` be denoted by \eqn{\beta_A} and \eqn{\beta_P}, respectively.
#' Let `TTE_A` and `TTE_P` be denoted by \eqn{\lambda_A} and \eqn{\lambda_P}, respectively.
#' Let `theta` be denoted by \eqn{\theta}, `phi` by \eqn{\phi}, `sigma` by \eqn{\sigma},
#' `Sigma` by \eqn{\Sigma}, and `df_sigma` by \eqn{\nu}.
#'
#' The parameters `TTE_A` and `theta` are chosen so that when GFR is 15, the event rate
#' is 1 per patient per year, and when GFR is 25, the event rate is 0.01 per patient per year. These
#' parameter values are obtained by solving
#' \deqn{
#' \lambda_g \exp(\theta \cdot \mathrm{GFR}) = \mathrm{rate}
#' }
#' for the group-specific baseline rate \eqn{\lambda_g} and \eqn{\theta}. When the observed eGFR is above 30,
#' the event rate is set to a very low value (`10e-7`), while when the observed eGFR is below or equal to 7,
#' the event rate is set to a very high value (`10e5`). This ensures that patients with observed low eGFR values
#' always experience KFRT, while those with high eGFR values do not.
#'
#' By default, the within-patient standard deviation, `sigma`, is set to `NULL`. When left as `NULL`, `sigma`
#' is calculated as
#' \deqn{
#' \sigma_{ij} = \sqrt{0.67 \cdot \mu_{ij}},
#' }
#' where \eqn{\mu_{ij}} denotes the predicted eGFR for patient \eqn{i} at visit \eqn{j}. This yields
#' time-dependent measurement variability, with lower predicted eGFR values corresponding to lower variability.
#' In the implementation, to prevent the variance from becoming negative or too small, the quantity
#' \eqn{0.67 \cdot \mu_{ij}} is truncated below at `0.1` before taking the square root.
#'
#' When `df_sigma = Inf` (the default), measurement errors are normally distributed:
#' \deqn{
#' \varepsilon_{ij} \sim N(0, \sigma_{ij}^2).
#' }
#' When `df_sigma` is finite and greater than 2, measurement errors follow a Student t distribution
#' with heavier tails:
#' \deqn{
#' \varepsilon_{ij} = \sigma_{ij}\sqrt{\frac{\nu - 2}{\nu}} T_{\nu},
#' }
#' where \eqn{\nu =} `df_sigma` and \eqn{T_{\nu}} is a standard t random variable with \eqn{\nu}
#' degrees of freedom. This scaling preserves the same time-dependent standard deviation defined by `sigma`,
#' so that
#' \deqn{
#' \mathrm{Var}(\varepsilon_{ij}) = \sigma_{ij}^2.
#' }
#'
#' Given the overall effect `Delta` and the placebo progression rate `CM_P`, a fully uniform (purely additive)
#' treatment effect—meaning the same average effect applies to all patients regardless of baseline progression—is
#' implemented by setting \eqn{\phi = 0} and
#' \deqn{
#' \beta_A = \Delta + \beta_P.
#' }
#' A fully proportional treatment effect—no additive component, the effect scales with the baseline rate—is
#' implemented by setting
#' \deqn{
#' \beta_A = \beta_P
#' }
#' and
#' \deqn{
#' \phi = \frac{\Delta}{|\beta_P|}.
#' }
#' A more relativistic intermediate effect (half additive and half proportional) is obtained by setting
#' \deqn{
#' \phi = \frac{\Delta}{2|\beta_P|}
#' }
#' and
#' \deqn{
#' \beta_A = \frac{\Delta}{2} + \beta_P.
#' }
#'
#' The kidney hierarchical composite endpoint is defined in the following order:
#' (1) Kidney Failure Replacement Therapy (KFRT); (2) Sustained eGFR < 15;
#' (3) Sustained 57 percent or more decline in eGFR; (4) Sustained 50 percent or more decline in eGFR;
#' (5) Sustained 40 percent or more decline in eGFR; and (6) Change in eGFR. In practice, because KFRT is
#' frequently initiated when true eGFR is very low, sustained eGFR < 15 events are rarely observed.
#'
#' If `two_meas` is not `"no"`, a second measurement is generated using the same latent baseline eGFR and
#' subject-specific slope, but with an independent measurement error draw from the same distribution as above.
#' The two measurements are then averaged at baseline when `two_meas = "base"`, at the final visit when
#' `two_meas = "postbase"`, or at both baseline and the final visit when `two_meas = "both"`. This implementation
#' preserves correlation between the duplicate measurements because they share the same underlying true trajectory.
#' @export
#' @md
#' @seealso [hce::simHCE()] for a general function of simulating `hce` datasets.
#' @examples
#' # Example - Specifying the most important variables
#' set.seed(2022)
#' ## The overall treatment effect
#' Delta <- 0.75
#' ## The placebo progression rate
#' CM_P <- - 4.5
#' ## Intermediate effect (half additive and half proportional)
#' delta <- Delta/2
#' CM_A <- delta + CM_P 
#' phi <- Delta / (2*abs(CM_P))
#' L <- simKHCE(n = 1000, CM_A = CM_A, CM_P = CM_P, 
#' fixedfy = 4, Emin = 25, Emax = 75, phi = phi)
#' dat <- L$HCE
#' calcWO(dat)
simKHCE <- function(n, CM_A, CM_P = - 4, n0 = n, TTE_A = 1000, TTE_P = TTE_A,  
                    fixedfy = 2, Emin = 20, Emax = 100, 
                    sigma = NULL, Sigma = 3,
                    m = 10, theta = - .4605, phi = 0, two_meas = c("no", "base", "postbase", "both"), df_sigma = Inf){
  two_meas <- match.arg(two_meas)
  n <- n[1] 
  CM_A <- CM_A[1] 
  CM_P <- CM_P[1] 
  n0 <- n0[1]
  TTE_A <- TTE_A[1]
  TTE_P <- TTE_P[1]  
  fixedfy <- fixedfy[1] 
  Emin <- Emin[1]
  Emax <- Emax[1]
  sigma <- sigma[1]
  Sigma <- Sigma[1]
  m <- round(m)[1]
  theta <- theta[1]
  phi <- phi[1]
  df_sigma <- df_sigma[1]
  stopifnot("The standard deviation `Sigma` should be positive." 
            = all(c(Sigma > 0)), 
            "`phi` should be in the interval [0, 1]" = all(c(phi >= 0, phi <= 1)),
            "GFR range `Emin` and `Emax` should be non-negative and `Emin` < `Emax`." = all(c(Emin >= 0, Emax >= 0, Emin < Emax)),
            "`m` must be >= 1" = m >= 1,
            "The measurement error degrees of freedom, `df_sigma`, must be numeric and greater than 2, or `Inf` for normal errors." = 
              is.numeric(df_sigma) && df_sigma > 2)
  if(!is.null(sigma)) stopifnot("The standard deviation `sigma` must be positive or left `NULL` for data-driven estimates." = sigma > 0)
  
  N <- n0 + n
  b0 <- CM_P
  b1 <- CM_A - CM_P
  c0 <- log(TTE_P)
  c1 <- log(TTE_A/TTE_P)
  c2 <- theta
  # Patient ID and treatment group
  d <- data.frame(ID = 1:N, TRTPN = c( rep(1, n),  rep(0, n0)))
  # Random patient-level slope with a given between-patient variability Sigma^2
  d$SLOPE <- b0 + stats::rnorm(N, mean = 0, sd = Sigma)
  # Implement proportionality for patients in the active group and negative (true) random slope
  d$SLOPE <- ifelse(d$TRTPN == 1 & d$SLOPE < 0, d$SLOPE*(1 - phi), d$SLOPE)
  # Implement additive effect (slope difference) for the patients in the active group
  d$SLOPE <-  d$SLOPE + b1*d$TRTPN 
  # Uniform random (true) baseline GFR from a given range. The observed baseline BASE will be different because of the sampling error (within-patient variability).
  d$BASE0 <- stats::runif(N, Emin, Emax)
  # Equidistant visit times. The number of visits is m + 1. Includes both the baseline visit and the visit at the end of the timeframe.
  tj <- (0:m)*fixedfy/m
  # Generate visits for all patients
  VISITS <- data.frame(ID = rep(1:N, each = m + 1), ADAY = rep(tj, times = N)) 
  # Merge to get the treatment groups
  d1 <- merge(VISITS, d, all.x = TRUE, by = "ID")
  # Random true slope is observed with a measurement error (within-patient variability is sigma^2)
  # sigma, by default, is derived based on the formula 0.67*predicted eGFR, which is time dependent.
  if(is.null(sigma)){
    VAR <- 0.67*(d1$SLOPE * d1$ADAY + d1$BASE0)
    VAR[VAR <= 0.1] <- 0.1 #prevent the variance being negative or too small.
    sigma <- sqrt(VAR)
  }
  if(is.infinite(df_sigma)){
    # If df_sigma is infinite, we use the normal distribution for the measurement error, which is the default.
    BASE <- d1$BASE0 + stats::rnorm(nrow(d1), sd = sigma)
  } else {
    # If df_sigma is finite, we use the t distribution for the measurement error, which has heavier tails than the normal distribution.
    BASE <- d1$BASE0 + sigma*sqrt((df_sigma - 2)/df_sigma)*stats::rt(nrow(d1), df = df_sigma)
  }
  d1$AVAL <- d1$SLOPE*d1$ADAY + ifelse(BASE <= Emin, Emin, ifelse(BASE >= Emax, Emax, BASE))
  d1$AVAL[d1$AVAL < 0] <- 0
  ######## Added a new implementation to handle double measurements at baseline or at PADY. #########
  if(two_meas != "no"){
    # BASE0 and SLOPE are the same for both measurements, hence they are correlated. ########
    if(is.infinite(df_sigma)){
      # If df_sigma is infinite, we use the normal distribution for the measurement error, which is the default.
      BASE1 <- d1$BASE0 + stats::rnorm(nrow(d1), sd = sigma)
    } else {
      # If df_sigma is finite, we use the t distribution for the measurement error, which has heavier tails than the normal distribution.
      BASE1 <- d1$BASE0 + sigma*sqrt((df_sigma - 2)/df_sigma)*stats::rt(nrow(d1), df = df_sigma)
    }
    d1$AVAL1 <- d1$SLOPE * d1$ADAY + ifelse(BASE1 <= Emin, Emin, ifelse(BASE1 >= Emax, Emax, BASE1))  
  }
  if(two_meas == "base"){
    d1$AVAL <- ifelse(d1$ADAY== 0, (d1$AVAL + d1$AVAL1)/2, d1$AVAL)
  } else if(two_meas == "postbase"){
    d1$AVAL <- ifelse(d1$ADAY == fixedfy, (d1$AVAL + d1$AVAL1)/2, d1$AVAL)
  } else if(two_meas == "both"){
    d1$AVAL <- ifelse(d1$ADAY == 0 | d1$ADAY == fixedfy, (d1$AVAL + d1$AVAL1)/2, d1$AVAL)
  }
  ################### END of the addition #########################
  # Extract time 0 measurements as baseline (observed baseline with sampling error)
  d2 <- d1[d1$ADAY == 0, c("ID", "AVAL")]
  names(d2) <- c("ID", "BASE")
  ## Simulate uniform random variables (should be subject specific!)
  d2$U <- stats::runif(nrow(d2))
  # Merge with the baseline variables (observed = BASE, true = BASE0)
  d3 <- merge(d1, d2, by = "ID", all.x = T)
  # Create patient-level KFRT incidence rates based on the true random slope
  ## Constant event-rates per group
  d3$RATE0 <- exp(c0 + c1*d3$TRTPN)
  ## Multiply the group-level incidence rates depending on the patient-level random (true) GFR slope at each visit interval.
  d3$RATE <- d3$RATE0*exp(c2*(d3$SLOPE*d3$ADAY + d3$BASE0))
  ## Make sure that patients with higher than 30 observed eGFR cannot have KFRT
  ## Make surer that patients with lower than 5 observed eGFR always have KFRT
  d3$RATE <- ifelse(d3$AVAL > 30, 10E-7, ifelse(d3$AVAL <= 7, 10E5, d3$RATE))
  ## Calculate the cumulative event rate for each patient
  ### CUMRATE must be aligned with the intended interval indexing per ID; otherwise, hazard accumulation can be wrong.
  d3 <- d3[order(d3$ID, d3$ADAY), ]
  d3$PADY <- fixedfy
  dt <- fixedfy/m
  d3$CUMHAZ <- stats::ave(d3$RATE*dt, d3$ID, FUN = cumsum)
  d3$V <- -log(d3$U)
  d4 <- d3[d3$V <= d3$CUMHAZ, ] #selects the intervals in which events happen
  ## Cumulative event rate minus the event rate in the current interval gives the cumulative event rate up to the current interval
  ## Use the cumulative event rate up to the current interval multiplied by the length of all intervals
  ## Use the log uniform added to it and divided by the rate of the current interval
  ## Add it to the current visit ADAY to initiate the event after the current visit
  if(nrow(d4) > 0){
    ## Order to correctly select the first event
    d4 <- d4[order(d4$ID, d4$ADAY), ]
    ## Select the first event
    d4 <- d4[!duplicated(d4$ID), ] 
    ## Generate the time of the first event
    d4$AVALT <- (d4$V - (d4$CUMHAZ - d4$RATE*dt))/d4$RATE + d4$ADAY
    ## d3$V <= d3$CUMHAZ selection above guarantees that d4$AVALT - d4$ADAY is less than dt
    ## Hence, by construction the below should not be needed, but protects against rounding issues.
    d4$AVALT <- pmin(d4$AVALT, d4$PADY)
    ##########################
    d5 <- merge(d3, d4[, c("ID", "AVALT")], all.x = TRUE, by = "ID")
    ## if event time is missing, then assign censoring.
    d5$EVENT <- NA
    d5$EVENT <- ifelse(is.na(d5$AVALT), 0, 1)
    d5[is.na(d5$AVALT), "AVALT"] <- fixedfy
  } else {
    d5 <- d3
    d5$EVENT <- 0
    d5$AVALT <- fixedfy
  }
  d5[, c("SLOPE", "BASE0", "RATE", "RATE0")] <- NULL
  # Calculate change and percent changes from baseline
  d5$CHG <- d5$AVAL - d5$BASE
  d5$PCHG <- (d5$AVAL / d5$BASE - 1)*100
  # Remove observations after the generated event (the event is kidney failure hence precludes measurements of GFR)
  d5 <- d5[d5$ADAY <= d5$AVALT, ]
  # Sort the dataset
  ADLB <- d5[order(d5$ID, d5$ADAY), ]
  # Derive sustained decline based on the laboratory measurements 
  d <- ADLB
  d$E40 <- ifelse(d$PCHG <= -40, 1, 0)
  d$E50 <- ifelse(d$PCHG <= -50, 1, 0)
  d$E57 <- ifelse(d$PCHG <= -57, 1, 0)
  d$E15 <- ifelse(d$AVAL < 15, 1, 0)
  sustained <- function(dat, x){
    dat <- as.data.frame(dat)
    dat <- dat[order(dat$ADAY), ]
    row.names(dat) <- NULL
    thr0 <- as.numeric(substr(x, 2, 3))
    thr <- ifelse(x == "E15", thr0, - thr0)
    I <- which(dat[, x] == 1)
    if(length(I) == 0)
      return(NULL)
    for(k in 1:length(I)){
      i <- I[k]
      t0 <- dat[i, "ADAY"]
      # use one month for the confirmation of the sustained decline
      t1 <- t0 + 1/12
      j <- which(dat$ADAY >= t1)[1]
      
      if(is.na(i) | is.na(j)) 
        next
      # Requires that all measurements during the window satisfy the criteria
      if(x %in% c("E57", "E50", "E40") & all(dat[i:j, "PCHG"] <= thr)){
        dat0 <- dat[i, c("ID", "ADAY", x)]
        names(dat0) <- c("ID", "ADAY", "EVENT")
        dat0$EVENT <- x
        return(dat0)
      }
      if(x %in% c("E15") & all(dat[i:j, "AVAL"] < thr)){
        dat0 <- dat[i, c("ID", "ADAY", x)]
        names(dat0) <- c("ID", "ADAY", "EVENT")
        dat0$EVENT <- x
        return(dat0)
      }
    }
    return(NULL)
  }
  l <- lapply(split(d, d$ID), sustained, x = "E40")
  E1 <- do.call(rbind, l)
  l <- lapply(split(d, d$ID), sustained, x = "E50")
  E2 <- do.call(rbind, l)
  l <- lapply(split(d, d$ID), sustained, x = "E57")
  E3 <- do.call(rbind, l)
  l <- lapply(split(d, d$ID), sustained, x = "E15")
  E4 <- do.call(rbind, l)
  ## The dataset of all events
  ADET0 <- rbind(E1, E2, E3, E4)
  if(!is.null(ADET0)){
    names(ADET0) <- c("ID", "AVAL0", "PARAMCD")  
  }
  ### filters GFR based events by severity
  E3 <- E3[!E3$ID %in% E4$ID, ]
  E2 <- E2[!E2$ID %in% c(E3$ID, E4$ID), ]
  E1 <- E1[!E1$ID %in% c(E2$ID, E3$ID, E4$ID), ]
  E <- rbind(E3, E2, E1, E4)
  if(!is.null(E)){
    names(E) <- c("ID", "AVAL0", "PARAMCD")  
  }
  ### adds change in GFR for those without a GFR based event
  d0 <- d[!d$ID %in% E$ID & d$ADAY == d$PADY, c("ID", "CHG")]
  if(nrow(d0) > 0){
    names(d0) <- c("ID", "AVAL0")
    d0$PARAMCD <- "GFR"  
  }
  ## Combines patients with GFR based events with patients without events to include their change in GFR at the end of follow-up
  d1 <- rbind(d0, E)
  ### In this step (which could have been much earlier), we select kidney failure replacement therapy events
  d2 <- unique(d[d$EVENT == 1, c("ID", "AVALT")])
  if(nrow(d2) > 0){
    d2$PARAMCD <- "KFRT"
    names(d2) <- c("ID", "AVAL0", "PARAMCD")  
  }
  ### Merges KFRT events in d2 with the other events / change in GFR values in d1 (removing those with KFRT from the other events to avoid duplication)
  d3 <- rbind(d1[!d1$ID %in% d2$ID, ], d2)
  ## Merges to add event names
  PARAM <- data.frame(PARAMCD = c("KFRT", "E15", "E57", "E50", "E40", "GFR"), PARAMN = 1:6)
  d4 <- merge(d3, PARAM, by = "PARAMCD", all.x = TRUE)
  d4 <- d4[, c("ID", "PARAMCD", "PARAMN", "AVAL0")]
  d4 <- d4[order(d4$ID), ]
  ############## Merges to have BASE GFR in the dataset
  d5 <- unique(d[, c("ID", "TRTPN", "PADY", "BASE")])
  d6 <- merge(d5, d4, by = "ID")
  ## Finalize ADLB by creating a character variable for treatment
  ADLB$TRTP <- ifelse(ADLB$TRTPN == 1, "A", "P")
  ######### Create final HCE dataset
  HCE <- d6
  HCE$TRTP <- ifelse(HCE$TRTPN == 1, "A", "P")
  HCE$GROUP <- factor(HCE$PARAMCD, levels = c("KFRT", "E15", "E57", "E50", "E40", "GFR"))
  levels(HCE$GROUP) <- c("Kidney Failure Replacement Therapy", "Sustained eGFR < 15 (mL/min/1.73 m2)", 
                         "Sustained >= 57% decline in eGFR", "Sustained >= 50% decline in eGFR", 
                         "Sustained >= 40% decline in eGFR", "Change in eGFR")
  ####### Create the final event-time dataset
  ADET <- rbind(ADET0, d2)
  if(!is.null(ADET)) ADET <- ADET[order(ADET$ID), ]
  ###############
  ### Clean the final GFR dataset
  ADLB[, c("U", "CUMHAZ", "V")] <- NULL
  ######## Create the final list of results
  L <- list(GFR = ADLB, ADET = ADET, HCE = as_hce(HCE))
  return(L)
}
