R/Gittins.r

In RARtrials: Response-Adaptive Randomization in Clinical Trials

#' @title Gittins Indices
#' @description \code{Gittins} can provide Gittins indices for binary reward processes
#' and normal reward processes with known and unknown variance for certain discount factors.
#' Binary reward process can handle scenarios with up to 2000 participants in a trial, while
#' normal reward process can handle scenarios with up to 10000 participants in a trial.
#' @details Gittins indices for binary outcomes are generated from \code{bmab_gi_multiple_ab} function from \code{gittins} package with
#' time horizon 100, 100, 100, 1000, 1000 for discount factor 0, 0.5, 0.7, 0.99 and 0.995 respectively.
#' Gittins indices for continuous outcomes are obtained by linear extrapolation using Table 8.1 and Table 8.3
#' in \insertCite{Gittins2011}{RARtrials}.
#' @export Gittins
#' @importFrom stats approx
#' @param Gittinstype type of Gittins indices, with choices from 'Binary', 'UNKV' and 'KV'.
#' 'Binary' represents binary outcomes, 'UNKV' and 'KV' represent continuous outcomes with
#'  known and unknown variance respectively.
#' @param df discount factor which is the multiplier for loss at each additional patient in the future.
#' Available values are 0.5, 0.6, 0.7, 0.8, 0.9, 0.95, 0.99 and 0.995 for \code{Gittinstype} in 'UNKV' and 'KV';
#' 0, 0.5, 0.7, 0.99 and 0.995 for \code{Gittinstype} in 'binary'.
#' @return A vector of Gittins indices for \code{Gittinstype} in 'UNKV' and 'KV'. A matrix of
#' Gittins indices for \code{Gittinstype} in 'Binary'.
#' @import pins
#' @examples
#' Gittins(Gittinstype='KV',df=0.5)
#' \donttest{
#' Gittins(Gittinstype='Binary',df=0.995)
#' Gittins(Gittinstype='UNKV',df=0.99)
#' }
#' @references 
#' \insertRef{Gittins2011}{RARtrials}

Gittins<-function(Gittinstype,df){
  if (Gittinstype=='UNKV') {
    indexx<-c(1,2,3,4,5,6,7,8,9,10,20,30,40,50,60,70,80,90,100,200,
              300,400,500,600,700,800,900,1000,10000)
    if (df==0.995){
      ratio<-c(0.12852,0.17192,0.20137,0.22398,0.24242,0.25803,0.27158,0.28356,
               0.29428,0.30400,0.36986,0.40886,0.43613,0.45679,0.47324,
               0.48677,0.49817,0.50796,0.51648,0.56637,0.59006,0.60436,
               0.61410,0.62123,0.62674,0.63116,0.63481,0.63789,0.6611221)
    }else if (df==0.99){
      ratio<-c(0.15758,0.20830,0.24184,0.26709,0.28736,0.30429,0.31881,0.33149,
               0.34275,0.35285,0.41888,0.45587,0.48072,0.49898,0.51313,0.52451,0.53391,
               0.54184,0.54864,0.58626,0.60270,0.61220,0.61844,0.62290,0.62629,
               0.62896,0.63121,0.63308,0.6473903)
    }else if (df==0.95){
      ratio<-c(0.22263,0.28366,0.32072,0.34687,0.36678,0.38267,0.39577,0.40682,
               0.41631,0.42458,0.47295,0.49583,0.50953,0.51876,0.52543,0.53050,0.53449,
               0.53771,0.54037,0.55344,0.55829,0.56084,0.56242,0.56351,0.56431,
               0.56493,0.56453,0.56583,0.583)
    }else if (df==0.9){
      ratio<-c(0.23609,0.29485,0.32876,0.35179,0.36879,0.382,0.39265,0.40146,
               0.40889,0.41526,0.45047,0.46577,0.47448,0.48013,0.48411,0.48707,0.48935,
               0.49117,0.49266,0.49970,0.50219,0.50347,0.50425,0.50478,0.50516,
               0.50545,0.50568,0.50587,0.5092)
    }else if (df==0.8){
      ratio<-c(0.22582,0.27584,0.30297,0.32059,0.33314,0.34261,0.35005,0.35607,
               0.36105,0.36525,0.38715,0.39593,0.40070,0.40370,0.40577,0.40728,0.40843,
               0.40934,0.41008,0.41348,0.41466,0.41525,0.41561,0.41585,0.41602,
               0.41615,0.41625,0.41633,0.41714)
    }else if (df==0.7){
      ratio<-c(0.20218,0.24359,0.26515,0.27874,0.28820,0.29521,0.30063,0.30496,
               0.30851,0.31147,0.32642,0.33215,0.33520,0.33709,0.33838,0.33932,0.34003,
               0.34059,0.34104,0.34311,0.34381,0.34416,0.34438,0.34452,0.34462,
               0.34470,0.34476,0.34480,0.34524)
    }else if (df==0.6){
      ratio<-c(0.17451,0.20815,0.22513,0.23560,0.24277,0.24801,0.25202,0.25520,
               0.25777,0.25991,0.27048,0.27443,0.27650,0.27778,0.27864,0.27927,0.27974,
               0.28011,0.28041,0.28177,0.28223,0.28246,0.28260,0.28270,0.28276,
               0.28281,0.28285,0.28288,0.28316)
    }else if (df==0.5){
      ratio<-c(0.14542,0.17209,0.18522,0.19317,0.19855,0.20244,0.20539,0.20771,
               0.20959,0.21113,0.21867,0.22142,0.22286,0.22374,0.22433,0.22476,0.22508,
               0.22534,0.22554,0.22646,0.22678,0.22693,0.22703,0.22709,0.22714,
               0.22717,0.2272,0.22722,0.22741)
    }

    xi<-(ratio/indexx/sqrt(1-df))
    x<-indexx
    y<-xi
    le<-approx(x, y, xout = c(seq(1,1000,by=1)))$y
    indexx<-c(2,3,4,5,6,7,8,9,10,20,30,40,50,60,70,80,90,100,200,
              300,400,500,600,700,800,900,1000)
    indexx1<-le[indexx]
    if (df==0.995){
      ratio<-c(52.950,3.851,1.289,71.073,47.376,35.483,28.192,23.292,19.784,7.522,
               4.479,3.136,2.390,1.919,1.597,1.364,1.188,1.050,0.476,0.305,0.224,0.178,0.149,
               0.129,0.114,0.102,0.094)
    }else if (df==0.99){
      ratio<-c(36.767,2.848,1.011,57.509,39.095,29.567,23.643,19.624,16.728,6.471,
               3.886,2.738,2.098,1.693,1.414,1.212,1.059,0.939,0.435,0.286, 0.207, 0.165,0.137,0.119,
               0.110,0.093,0.084)
    }else if (df==0.95){
      ratio<-c(14.988,1.438,0.597,36.487,25.865,20.039,16.308,13.722,11.829,4.868,
               3.021,2.179,1.7,1.392,1.178,1.02,0.899,0.804,0.39,0.257,0.192,
               0.153,0.127,0.109,0.096,0.085,0.078)
    }else if (df==0.9){
      ratio<-c(10.088,1.123,0.496,31.228,22.512,17.635,14.470,12.257,10.624,4.507,2.840,
               2.068,1.625,1.337,1.136,0.987,0.873,0.782,0.383,0.254,0.19,0.152,
               0.126,0.108,0.095,0.084,0.076)
    }else if (df==0.8){
      ratio<-c(8.132,0.923,0.432,27.842,20.365,16.11,13.316,11.345,9.881,4.301,2.741,
               2.010,1.586,1.31,1.115,0.972,0.86,0.771,0.38,0.252,0.189,
               0.151,0.126,0.108,0.095,0.084,0.076)
    }else if (df==0.7){
      ratio<-c(5.995,0.847,0.408,26.601,19.585,15.563,12.907,11.025,9.622,4.233,2.71,
               1.992,1.574,1.301,1.109,0.966,0.856,0.768,0.379,0.252,0.189,0.151,
               0.125,0.108,0.094,0.084,0.076)
    }else if (df==0.6){
      ratio<-c(5.365,0.81,0.396,26.003,19.212,15.303,12.714,10.882,9.502,4.203,2.696,
               1.984,1.569,1.298,1.106,0.964,0.854,0.767,0.38,0.251,0.188,0.151,
               0.126,0.107,0.095,0.084,0.076)
    }else if (df==0.5){
      ratio<-c(0.971,0.789,0.389,25.681,19.012,15.165,12.612,10.797,9.44,4.188,2.689,
               1.98,1.566,1.296,1.106,0.963,0.854,0.766,0.38,0.253,0.188,0.151,
               0.126,0.108,0.094,0.083,0.074)
    }

    xi=c((ratio[1:3]+1)*indexx1[1:3],(ratio[4:27]/100+1)*indexx1[4:27])
    x<-c(indexx,10000)
    if (df==0.995){
      y<-c(xi,0.6611221)
    }else if (df==0.99){
      y<-c(xi,0.6473903)
    }else if (df==0.95){
      y<-c(xi,0.583)
    }else if (df==0.9){
      y<-c(xi,0.5092)
    }else if (df==0.8){
      y<-c(xi,0.41714)
    }else if (df==0.7){
      y<-c(xi,0.34524)
    }else if (df==0.6){
      y<-c(xi,0.28316)
    }else if (df==0.5){
      y<-c(xi,0.22741)
    }

    GI<-approx(x, y, xout = c(seq(1,10000,by=1)))$y

  }

  if (Gittinstype=='KV') {

    indexx<-c(1,2,3,4,5,6,7,8,9,10,20,30,40,50,60,70,80,90,100,200,
              300,400,500,600,700,800,900,1000,10000)
    if (df==0.995){
      ratio<-c(0.12852,0.17192,0.20137,0.22398,0.24242,0.25803,0.27158,0.28356,
               0.29428,0.30400,0.36986,0.40886,0.43613,0.45679,0.47324,
               0.48677,0.49817,0.50796,0.51648,0.56637,0.59006,0.60436,
               0.61410,0.62123,0.62674,0.63116,0.63481,0.63789,0.6611221)
    }else if (df==0.99){
      ratio<-c(0.15758,0.20830,0.24184,0.26709,0.28736,0.30429,0.31881,0.33149,
               0.34275,0.35285,0.41888,0.45587,0.48072,0.49898,0.51313,0.52451,0.53391,
               0.54184,0.54864,0.58626,0.60270,0.61220,0.61844,0.62290,0.62629,
               0.62896,0.63121,0.63308,0.6473903)
    }else if (df==0.95){
      ratio<-c(0.22263,0.28366,0.32072,0.34687,0.36678,0.38267,0.39577,0.40682,
               0.41631,0.42458,0.47295,0.49583,0.50953,0.51876,0.52543,0.53050,0.53449,
               0.53771,0.54037,0.55344,0.55829,0.56084,0.56242,0.56351,0.56431,
               0.56493,0.56453,0.56583,0.583)
    }else if (df==0.9){
      ratio<-c(0.23609,0.29485,0.32876,0.35179,0.36879,0.382,0.39265,0.40146,
               0.40889,0.41526,0.45047,0.46577,0.47448,0.48013,0.48411,0.48707,0.48935,
               0.49117,0.49266,0.49970,0.50219,0.50347,0.50425,0.50478,0.50516,
               0.50545,0.50568,0.50587,0.5092)
    }else if (df==0.8){
      ratio<-c(0.22582,0.27584,0.30297,0.32059,0.33314,0.34261,0.35005,0.35607,
               0.36105,0.36525,0.38715,0.39593,0.40070,0.40370,0.40577,0.40728,0.40843,
               0.40934,0.41008,0.41348,0.41466,0.41525,0.41561,0.41585,0.41602,
               0.41615,0.41625,0.41633,0.41714)
    }else if (df==0.7){
      ratio<-c(0.20218,0.24359,0.26515,0.27874,0.28820,0.29521,0.30063,0.30496,
               0.30851,0.31147,0.32642,0.33215,0.33520,0.33709,0.33838,0.33932,0.34003,
               0.34059,0.34104,0.34311,0.34381,0.34416,0.34438,0.34452,0.34462,
               0.34470,0.34476,0.34480,0.34524)
    }else if (df==0.6){
      ratio<-c(0.17451,0.20815,0.22513,0.23560,0.24277,0.24801,0.25202,0.25520,
               0.25777,0.25991,0.27048,0.27443,0.27650,0.27778,0.27864,0.27927,0.27974,
               0.28011,0.28041,0.28177,0.28223,0.28246,0.28260,0.28270,0.28276,
               0.28281,0.28285,0.28288,0.28316)
    }else if (df==0.5){
      ratio<-c(0.14542,0.17209,0.18522,0.19317,0.19855,0.20244,0.20539,0.20771,
               0.20959,0.21113,0.21867,0.22142,0.22286,0.22374,0.22433,0.22476,0.22508,
               0.22534,0.22554,0.22646,0.22678,0.22693,0.22703,0.22709,0.22714,
               0.22717,0.2272,0.22722,0.22741)
    }
    xi<-(ratio/indexx/sqrt(1-df))
    x<-indexx
    y<-xi
    GI<-approx(x, y, xout = c(seq(1,10000,by=1)))$y
  }

  if (Gittinstype=='Binary'){
    board<-pins::board_url('https://raw.githubusercontent.com/yayayaoyaoyao/GI/main/pins-board/_pins.yaml')
     
    if (df==0){
      GI<-pin_read(board,'Gittins0')
    }else if (df==0.5){
      GI<-pin_read(board,'Gittins05')
      #GI<-GI::Gittins05
    }else if (df==0.995){
      GI<-pin_read(board,'Gittins0995')
      #GI<-GI::Gittins0995
    }else if (df==0.7){
      GI<-pin_read(board,'Gittins07')
      #GI<-GI::Gittins07
    }else if (df==0.99){
      GI<-pin_read(board,'Gittins099')
      #GI<-GI::Gittins099
    }
  }

  return(GI)
}