R/ocTable_multi.R

In lylyf1987/GNGpkg:

#' Title
#'
#' @param DesignTable data.frame of go and no go decision values in order. must have columns called MaxNoGo, MinGo, n
#' @param TargetRate the true rate
#'
#' @return returns a frame with the OC characteristics at the specified rate.
#' @export
#' @import tidyr
#' @import dplyr
#' @import stats
#'
#' @examples
ocTable_multi <- function(DesignTable,TargetRate){
  # browser()
  ocProbMat <- probmat.func(DesignTable,TargetRate)
  MAT <- as_tibble(ocProbMat)
  colnames(MAT) <- paste('Analysis',1:ncol(MAT))
  
  fgo <- DesignTable$MinGo[nrow(DesignTable)]
  fnogo <- DesignTable$MaxNoGo[nrow(DesignTable)]
  N <- DesignTable$n[nrow(DesignTable)]
  
  TBL <- cbind(X=0:(nrow(MAT)-1),MAT) %>%
    gather('Analysis','Prob',-X) %>%
    left_join(DesignTable %>%
                mutate(Analysis = paste('Analysis',1:n())),
              by='Analysis') %>%
    group_by(Analysis) %>%
    summarise(`First Go` = sum(Prob[X >= MinGo]),
              `First No Go` = sum(Prob[X <= MaxNoGo]),
              `Grey Area` = sum(Prob[X > MaxNoGo & X < MinGo]),
              `Discordant Go` =`First Go` * Discord_Go(MinGo[1],n[1],fgo,N,TargetRate,Weights = pull(MAT,Analysis[1])[MinGo[1]:n[1]+1]),
              `Discordant No Go` =`First No Go` * Discord_NoGo(MaxNoGo[1],n[1],fnogo,N,TargetRate,Weights = pull(MAT,Analysis[1])[0:MaxNoGo[1]+1]),
              `Discordant Grey`= `Grey Area` * Discord_Grey(MaxNoGo[1]+1,MinGo[1]-1,n[1],fgo,fnogo,N,TargetRate,Weights = pull(MAT,Analysis[1])[(MaxNoGo[1]+1):(MinGo[1]-1)+1])
    )
  
  TBL %>%
    rbind(
      tibble(
        Analysis = 'Final-solo',
        `First Go` = 1-pbinom(fgo-1,N,TargetRate),
        `First No Go` = pbinom(fnogo,N,TargetRate),
        `Grey Area` = 1-`First Go`-`First No Go`,
        `Discordant Go` = NA,
        `Discordant No Go` = NA,
        `Discordant Grey` = NA
      )
    ) %>%
    rbind(
      TBL %>%
        gather('Var','Val',-Analysis) %>%
        group_by(Var) %>%
        summarise(Sum = sum(Val)) %>%
        spread(Var,Sum) %>%
        mutate(
          `Grey Area`=TBL$`Grey Area`[nrow(TBL)],
          `Discordant Grey` =TBL$`Discordant Grey`[nrow(TBL)-1],
          Analysis='Overall')
    ) %>%
    mutate(targetRate=TargetRate)
}