R/recruitment_functions.R

In gsearly: Creates Group Sequential Trial Designs when Early Outcomes are Available

#-------------------------------------------------------------------------------
# Recruitment functions for gsearly
#-------------------------------------------------------------------------------
# 1st July 2026
#-------------------------------------------------------------------------------

#-------------------------------------------------------------------------------
# 29.  .selectRmodel
#-------------------------------------------------------------------------------
.selectRmodel <- function(rmodel = "fix") {
  if (rmodel == "ilin") {
    ## Model ilin
    rilin <- list(g = function(tt, tr, trecruit, m) {
      ## Model ilin: g(.)
      td <- tt - tr
      if (tt < tr) {
        gr <- 0
      } else if (tt > tr + trecruit) {
        gr <- trecruit * (trecruit + 1)
      } else {
        gr <- td * (td + 1)
      }
      return(gr)
    }, k = function(n, trecruit, m) {
      ## Model ilin: k(.)
      k <- n/(trecruit * (trecruit + 1))
      return(k)
    }, r = function(tt, n, trecruit, m) {
      ## Model ilin: r(.)
      if (tt < 1) {
        r <- 0
      } else if (tt > trecruit) {
        r <- 0
      } else {
        r <- (2 * n * tt)/(trecruit * (trecruit + 1))
      }
      return(r)
    })
    fg <- rilin[["g"]]
    fk <- rilin[["k"]]
    fr <- rilin[["r"]]
  } else if (rmodel == "dlin") {
    ## Model dlin
    rdlin <- list(g = function(tt, tr, trecruit, m) {
      ## Model dlin: g(.)
      td <- tt - tr
      if (tt < tr) {
        gr <- 0
      } else if (tt > tr + trecruit) {
        gr <- trecruit * (trecruit + 1)
      } else {
        gr <- td * (2 * trecruit - td + 1)
      }
      return(gr)
    }, k = function(n, trecruit, m) {
      ## Model dlin: k(.)
      k <- n/(trecruit * (trecruit + 1))
      return(k)
    }, r = function(tt, n, trecruit, m) {
      ## Model dlin: r(.)
      if (tt < 1) {
        r <- 0
      } else if (tt > trecruit) {
        r <- 0
      } else {
        r <- (2 * n * (trecruit - tt + 1))/(trecruit * (trecruit +
          1))
      }
      return(r)
    })
    fg <- rdlin[["g"]]
    fk <- rdlin[["k"]]
    fr <- rdlin[["r"]]
  } else if (rmodel == "iquad") {
    ## Model iquad
    riquad <- list(g = function(tt, tr, trecruit, m) {
      ## Model iquad: g(.)
      td <- tt - tr
      if (tt < tr) {
        gr <- 0
      } else if (tt > tr + trecruit) {
        gr <- trecruit * (trecruit + 1) * (2 * trecruit + 1)
      } else {
        gr <- td * (td + 1) * (2 * td + 1)
      }
      return(gr)
    }, k = function(n, trecruit, m) {
      ## Model iquad: k(.)
      k <- n/(trecruit * (trecruit + 1) * (2 * trecruit + 1))
      return(k)
    }, r = function(tt, n, trecruit, m) {
      ## Model iquad: r(.)
      if (tt < 1) {
        r <- 0
      } else if (tt > trecruit) {
        r <- 0
      } else {
        r <- (6 * n * (tt^2))/(trecruit * (trecruit + 1) * (2 *
          trecruit + 1))
      }
      return(r)
    })
    fg <- riquad[["g"]]
    fk <- riquad[["k"]]
    fr <- riquad[["r"]]
  } else if (rmodel == "dquad") {
    ## Model dquad
    rdquad <- list(g = function(tt, tr, trecruit, m) {
      ## Model dquad: g(.)
      td <- tt - tr
      if (tt < tr) {
        gr <- 0
      } else if (tt > tr + trecruit) {
        gr <- trecruit * (trecruit + 1) * (2 * trecruit + 1)
      } else {
        gr <- td * (6 * (trecruit + 1) * (trecruit - td) + (td +
          1) * (2 * td + 1))
      }
      return(gr)
    }, k = function(n, trecruit, m) {
      ## Model dquad: k(.)
      k <- n/(trecruit * (trecruit + 1) * (2 * trecruit + 1))
      return(k)
    }, r = function(tt, n, trecruit, m) {
      ## Model dquad: r(.)
      if (tt < 1) {
        r <- 0
      } else if (tt > trecruit) {
        r <- 0
      } else {
        r <- (6 * n * (((trecruit + 1) - tt)^2))/(trecruit * (trecruit +
          1) * (2 * trecruit + 1))
      }
      return(r)
    })
    fg <- rdquad[["g"]]
    fk <- rdquad[["k"]]
    fr <- rdquad[["r"]]
  } else if (rmodel == "idlin") {
    ## Model idlin
    ridlin <- list(g = function(tt, tr, trecruit, m) {
      ## Model idlin: g(.)
      td <- tt - tr
      if (tt < tr) {
        gr <- 0
      } else if (tt > tr + trecruit) {
        gr <- (m^2) * trecruit * (trecruit + 1) -
          2 * (trecruit^2) * (m - 1)
      } else {
        if (tt <= ((trecruit/m) + tr) & tt >= tr) {
          gr <- (m^2) * td * (td + 1)
        } else if (tt > ((trecruit/m) + tr) & tt <= tr + trecruit) {
          gr <- (m^2) * td * (2 * trecruit - td + 1) - 2 * (trecruit^2) *
          (m - 1)
        }
      }
      return(gr)
    }, k = function(n, trecruit, m) {
      ## Model idlin: k(.)
      k <- n/(trecruit * ((m^2) * (trecruit + 1) - 2 * trecruit *
        (m - 1)))
      return(k)
    }, r = function(tt, n, trecruit, m) {
      ## Model idlin: r(.)
      if (tt < 1) {
        r <- 0
      } else if (tt > trecruit) {
        r <- 0
      } else {
        if (tt <= (trecruit/m)) {
          r <- (2 * n * (m^2) * tt)/(trecruit * ((m^2) * (trecruit +
          1) - 2 * trecruit * (m - 1)))
        } else if (tt > (trecruit/m)) {
          r <- (2 * n * (m^2) * (trecruit - tt + 1))/(trecruit *
          ((m^2) * (trecruit + 1) - 2 * trecruit * (m - 1)))
        }
      }
      return(r)
    })
    fg <- ridlin[["g"]]
    fk <- ridlin[["k"]]
    fr <- ridlin[["r"]]
  } else if (rmodel == "dilin") {
    ## Model dilin
    rdilin <- list(g = function(tt, tr, trecruit, m) {
      ## Model dilin: g(.)
      td <- tt - tr
      if (tt < tr) {
        gr <- 0
      } else if (tt > tr + trecruit) {
        gr <- (m^2) * trecruit * (trecruit + 1) + 2 * (trecruit^2) *
          (m - 1)
      } else {
        if (tt <= ((trecruit/m) + tr) & tt >= tr) {
          gr <- (m^2) * td * (2 * trecruit - td + 1)
        } else if (tt > ((trecruit/m) + tr) & tt <= tr + trecruit) {
          gr <- (m^2) * td * (td + 1) + 2 * (trecruit^2) * (m -
          1)
        }
      }
      return(gr)
    }, k = function(n, trecruit, m) {
      ## Model dilin: k(.)
      k <- n/(trecruit * ((m^2) * (trecruit + 1) + 2 * trecruit *
        (m - 1)))
      return(k)
    }, r = function(tt, n, trecruit, m) {
      ## Model dilin: r(.)
      if (tt < 1) {
        r <- 0
      } else if (tt > trecruit) {
        r <- 0
      } else {
        if (tt <= (trecruit/m)) {
          r <- (2 * n * (m^2) * (trecruit - tt + 1))/(trecruit *
          ((m^2) * (trecruit + 1) + 2 * trecruit * (m - 1)))
        } else if (tt > (trecruit/m)) {
          r <- (2 * n * (m^2) * tt)/(trecruit * ((m^2) * (trecruit +
          1) + 2 * trecruit * (m - 1)))
        }
      }
      return(r)
    })
    fg <- rdilin[["g"]]
    fk <- rdilin[["k"]]
    fr <- rdilin[["r"]]
  } else if (rmodel == "diquad") {
    ## Model diquad
    rdiquad <- list(g = function(tt, tr, trecruit, m) {
      ## Model diquad: g(.)
      td <- tt - tr
      if (tt < tr) {
        gr <- 0
      } else if (tt > tr + trecruit) {
        gr <- (m^2) * trecruit * (trecruit + 1) * (2 * trecruit +
          1) + 6 * (m - 1) * (trecruit^2) * (trecruit + 1)
      } else {
        if (tt <= ((trecruit/m) + tr)) {
          gr <- (m^2) * td * (6 * (trecruit + 1) * (trecruit -
          td) + (td + 1) * (2 * td + 1))
        } else if (tt > ((trecruit/m) + tr)) {
          gr <- (m^2) * td * (td + 1) * (2 * td + 1) + 6 * (m -
          1) * (trecruit^2) * (trecruit + 1)
        }
      }
      return(gr)
    }, k = function(n, trecruit, m) {
      ## Model diquad: k(.)
      k <- n/((trecruit + 1) * (6 * (m - 1) * (trecruit^2) + (m^2) *
        trecruit * (2 * trecruit + 1)))
      return(k)
    }, r = function(tt, n, trecruit, m) {
      ## Model diquad: r(.)
      if (tt < 1) {
        r <- 0
      } else if (tt > trecruit) {
        r <- 0
      } else {
        if (tt <= (trecruit/m)) {
          r <- (6 * n * (m^2) * (((trecruit + 1) - tt)^2))/((trecruit +
          1) * (6 * (m - 1) * (trecruit^2) + (m^2) * trecruit *
          (2 * trecruit + 1)))
        } else if (tt > (trecruit/m)) {
          r <- (6 * n * (m^2) * (tt^2))/((trecruit + 1) * (6 *
          (m - 1) * (trecruit^2) + (m^2) * trecruit * (2 * trecruit +
          1)))
        }
      }
      return(r)
    })
    fg <- rdiquad[["g"]]
    fk <- rdiquad[["k"]]
    fr <- rdiquad[["r"]]
  } else if (rmodel == "idquad") {
    ## Model idquad
    ridquad <- list(g = function(tt, tr, trecruit, m) {
      ## Model idquad: g(.)
      td <- tt - tr
      if (tt < tr) {
        gr <- 0
      } else if (tt > tr + trecruit) {
        gr <- (m^2) * trecruit * (trecruit + 1) * (2 * trecruit +
          1) - 6 * (m - 1) * (trecruit^2) * (trecruit + 1)
      } else {
        if (tt <= ((trecruit/m) + tr)) {
          gr <- (m^2) * td * (td + 1) * (2 * td + 1)
        } else if (tt > ((trecruit/m) + tr)) {
          gr <- (m^2) * td * (6 * (trecruit + 1) * (trecruit -
          td) + (td + 1) * (2 * td + 1)) - 6 * (m - 1) * (trecruit^2) *
          (trecruit + 1)
        }
      }
      return(gr)
    }, k = function(n, trecruit, m) {
      ## Model idquad: k(.)
      k <- n/((trecruit + 1) * ((m^2) * trecruit * (2 * trecruit +
        1) - 6 * (m - 1) * (trecruit^2)))
      return(k)
    }, r = function(tt, n, trecruit, m) {
      ## Model idquad: r(.)
      if (tt < 1) {
        r <- 0
      } else if (tt > trecruit) {
        r <- 0
      } else {
        if (tt <= (trecruit/m)) {
          r <- (6 * n * (m^2) * (tt^2))/((trecruit + 1) * ((m^2) *
          trecruit * (2 * trecruit + 1) - 6 * (m - 1) * (trecruit^2)))
        } else if (tt > (trecruit/m)) {
          r <- (6 * n * (m^2) * (((trecruit + 1) - tt)^2))/((trecruit +
          1) * ((m^2) * trecruit * (2 * trecruit + 1) - 6 * (m -
          1) * (trecruit^2)))
        }
      }
      return(r)
    })
    fg <- ridquad[["g"]]
    fk <- ridquad[["k"]]
    fr <- ridquad[["r"]]
  } else if (rmodel == "filin") {
    ## Model filin
    rfilin <- list(g = function(tt, tr, trecruit, m) {
      ## Model filin: g(.)
      td <- tt - tr
      if (tt < tr) {
        gr <- 0
      } else if (tt > tr + trecruit) {
        gr <- (m^2) * trecruit * (trecruit + 1) + (trecruit^2) *
          (m - 1)
      } else {
        if (tt <= ((trecruit/m) + tr) & tt >= tr) {
          gr <- (m^2) * td * (trecruit + 1)
        } else if (tt > ((trecruit/m) + tr) & tt <= tr + trecruit) {
          gr <- (m^2) * td * (td + 1) + (trecruit^2) * (m - 1)
        }
      }
      return(gr)
    }, k = function(n, trecruit, m) {
      ## Model filin: k(.)
      k <- n/(trecruit * ((m^2) * (trecruit + 1) + trecruit *
                            (m - 1)))
      return(k)
    }, r = function(tt, n, trecruit, m) {
      ## Model filin: r(.)
      if (tt < 1) {
        r <- 0
      } else if (tt > trecruit) {
        r <- 0
      } else {
        if (tt <= (trecruit/m)) {
          r <- (n * (m^2) * (trecruit + 1))/(trecruit * ((m^2) * (trecruit +
                1) + trecruit * (m - 1)))
        } else if (tt > (trecruit/m)) {
          r <- (2 * n * (m^2) * tt)/(trecruit * ((m^2) * (trecruit +
                1) + trecruit * (m - 1)))
        }
      }
      return(r)
    })
    fg <- rfilin[["g"]]
    fk <- rfilin[["k"]]
    fr <- rfilin[["r"]]
  } else if (rmodel == "fdlin") {
    ## Model fdlin
    rfdlin <- list(g = function(tt, tr, trecruit, m) {
      ## Model fdlin: g(.)
      td <- tt - tr
      if (tt < tr) {
        gr <- 0
      } else if (tt > tr + trecruit) {
        gr <- (m^2) * trecruit * (trecruit + 1) - (trecruit^2) *
          (m - 1)
      } else {
        if (tt <= ((trecruit/m) + tr) & tt >= tr) {
          gr <- (m^2) * td * (trecruit + 1)
        } else if (tt > ((trecruit/m) + tr) & tt <= tr + trecruit) {
          gr <- (m^2) * td * (2 * trecruit - td + 1) - (trecruit^2) * (m - 1)
        }
      }
      return(gr)
    }, k = function(n, trecruit, m) {
      ## Model fdlin: k(.)
      k <- n/(trecruit * ((m^2) * (trecruit + 1) - trecruit *
                            (m - 1)))
      return(k)
    }, r = function(tt, n, trecruit, m) {
      ## Model fdlin: r(.)
      if (tt < 1) {
        r <- 0
      } else if (tt > trecruit) {
        r <- 0
      } else {
        if (tt <= (trecruit/m)) {
          r <- (n * (m^2) * (trecruit + 1))/(trecruit *
                ((m^2) * (trecruit + 1) - trecruit * (m - 1)))
        } else if (tt > (trecruit/m)) {
          r <- (2 * n * (m^2) * (trecruit - tt + 1))/
            (trecruit * ((m^2) * (trecruit + 1) - trecruit * (m - 1)))
        }
      }
      return(r)
    })
    fg <- rfdlin[["g"]]
    fk <- rfdlin[["k"]]
    fr <- rfdlin[["r"]]
  } else if (rmodel == "ilinf") {
      ## Model ilinf
      rilinf <- list(g = function(tt, tr, trecruit, m) {
        ## Model filin: g(.)
        td <- tt - tr
        if (tt < tr) {
          gr <- 0
        } else if (tt > tr + trecruit) {
          gr <- (m^2) * trecruit * (trecruit + 1) - (trecruit^2) * (m - 1)
        } else {
          if (tt <= ((trecruit/m) + tr) & tt >= tr) {
            gr <- (m^2) * td * (td + 1)
          } else if (tt > ((trecruit/m) + tr) & tt <= tr + trecruit) {
            gr <- (m^2) * td * (trecruit + 1) - (trecruit^2) * (m - 1)
          }
        }
        return(gr)
      }, k = function(n, trecruit, m) {
        ## Model ilinf: k(.)
        k <- n/(trecruit * ((m^2) * (trecruit + 1) - trecruit * (m - 1)))
        return(k)
      }, r = function(tt, n, trecruit, m) {
        ## Model ilinf: r(.)
        if (tt < 1) {
          r <- 0
        } else if (tt > trecruit) {
          r <- 0
        } else {
          if (tt <= (trecruit/m)) {
            r <- (2 * n * (m^2) * tt)/(trecruit *
                  ((m^2) * (trecruit + 1) - trecruit * (m - 1)))
          } else if (tt > (trecruit/m)) {
            r <- (n * (m^2) * (trecruit + 1))/(trecruit *
                  ((m^2) * (trecruit + 1) - trecruit * (m - 1)))
          }
        }
        return(r)
      })
      fg <- rilinf[["g"]]
      fk <- rilinf[["k"]]
      fr <- rilinf[["r"]]
  } else if (rmodel == "dlinf") {
    ## Model dlinf
    rdlinf <- list(g = function(tt, tr, trecruit, m) {
      ## Model dlinf: g(.)
      td <- tt - tr
      if (tt < tr) {
        gr <- 0
      } else if (tt > tr + trecruit) {
        gr <- (m^2) * trecruit * (trecruit + 1) + (trecruit^2) * (m - 1)
      } else {
        if (tt <= ((trecruit/m) + tr) & tt >= tr) {
          gr <- (m^2) * td * (2 * trecruit - td + 1)
        } else if (tt > ((trecruit/m) + tr) & tt <= tr + trecruit) {
          gr <- (m^2) * td * (trecruit + 1) + (trecruit^2) * (m - 1)
        }
      }
      return(gr)
    }, k = function(n, trecruit, m) {
      ## Model dlinf: k(.)
      k <- n/(trecruit * ((m^2) * (trecruit + 1) + trecruit * (m - 1)))
      return(k)
    }, r = function(tt, n, trecruit, m) {
      ## Model dlinf: r(.)
      if (tt < 1) {
        r <- 0
      } else if (tt > trecruit) {
        r <- 0
      } else {
        if (tt <= (trecruit/m)) {
          r <- (2 * n * (m^2) * (trecruit - tt + 1))/(trecruit *
                    ((m^2) * (trecruit + 1) + trecruit * (m - 1)))
        } else if (tt > (trecruit/m)) {
          r <- (n * (m^2) * (trecruit + 1))/(trecruit *
                    ((m^2) * (trecruit + 1) + trecruit * (m - 1)))
        }
      }
      return(r)
    })
    fg <- rdlinf[["g"]]
    fk <- rdlinf[["k"]]
    fr <- rdlinf[["r"]]
  } else {
    ## Model fix (default)
    rfix <- list(g = function(tt, tr, trecruit, m) {
      ## Model fix: g(.)
      td <- tt - tr
      if (tt < tr) {
        gr <- 0
      } else if (tt > (tr + trecruit)) {
        gr <- trecruit
      } else {
        gr <- td
      }
      return(gr)
    }, k = function(n, trecruit, m) {
      ## Model fix: k(.)
      k <- n/trecruit
      return(k)
    }, r = function(tt, n, trecruit, m) {
      ## Model fix: r(.)
      if (tt < 1) {
        r <- 0
      } else if (tt > trecruit) {
        r <- 0
      } else {
        r <- n/trecruit
      }
      return(r)
    })
    fg <- rfix[["g"]]
    fk <- rfix[["k"]]
    fr <- rfix[["r"]]
  }
  return(list(fg = fg, fk = fk, fr = fr))
}
#-------------------------------------------------------------------------------
#-------------------------------------------------------------------------------

#-------------------------------------------------------------------------------
# end
#-------------------------------------------------------------------------------