R/toxTable_cycle_subfunctions.R

#' @importFrom stats aggregate

.toxTable_cycle = function(rt, cycles) {



  if (rt@options@toxTable_discardToxAtStudyEntry) {
    rt@toxData = rt@toxData[rt@toxData$rel_ae_start >= 0 & !is.na(rt@toxData$rel_ae_start), ]
  }

  # toxicities in AssTrue
  toxDataSub = rt@toxData[rt@toxData$ass_TRUE, ]

  # Subset to the cycles of interest
  toxDataSub = .subSetAEToCycle(rt, toxDataSub, cycles)

  # generate initial table
  if(rt@options@toxTable_cycle_tabulationMethod == "worst"){
    toxTable = .toxTable_worst(toxDataSub, rt, rt@treatmentCodes)
  } else if(rt@options@toxTable_cycle_tabulationMethod == "all"){
    toxTable = .toxTable_all(toxDataSub, rt, rt@treatmentCodes)
  }

  ## Ordering
  if(rt@options@toxTable_cycle_toxicityOrder == "a"){
    toxTable = toxTable[order(toxTable[,2]), ]
  } else if(substr(rt@options@toxTable_cycle_toxicityOrder,1,1) == "n") {
    if(nchar(rt@options@toxTable_cycle_toxicityOrder) > 1) {
      mingrade = as.numeric(substr(rt@options@toxTable_cycle_toxicityOrder,2,2))
    } else {
      mingrade = 1
    }
    columns = 5*rep(1:length(rt@treatmentCodes), each = length(mingrade:5))-2 +  mingrade:5
    counts = sapply(1:dim(toxTable)[1], function(x) sum(as.numeric(toxTable[x,columns]), na.rm = TRUE))
    countsAll = sapply(1:dim(toxTable)[1], function(x) sum(as.numeric(toxTable[x,3 + 1:(5*length(rt@treatmentCodes))]), na.rm = TRUE))
    toxTable = toxTable[order(counts, countsAll, decreasing = TRUE), ]

  } else { # order = "c"
    # Order according to toxID (ensuring that the toxicities are ordered alphabetically first by category and then by toxicity)
    toxTable = toxTable[order(as.numeric(as.character(toxTable$toxID)), decreasing = FALSE), ]
    toxTable = toxTable[which(toxTable$toxicity!= ""), ]
  }

  # Perform the column merge for toxicities
  if(is.null(rt@options@toxTable_mergeGrades) == FALSE){
    colMerge = strsplit(rt@options@toxTable_mergeGrades, "[|]")[[1]]
    if("n" %in% colMerge) {
      colMerge = colMerge[-(colMerge == "n")]
    }
    toxTableClean = data.frame(toxID = toxTable$toxID, category = toxTable$category, toxicity = toxTable$toxicity, stringsAsFactors = FALSE)
    for(side in 1:length(rt@treatmentCodes)){
      for(col in colMerge){
        if(rt@options@toxTable_cumulativeGrades) {

          composition = min(as.numeric(strsplit(col, ",")[[1]])):5
          cols = paste0("tox.", side, ".", composition)
          cname = paste0("tox.", side, ".", composition[1])
          if(length(composition) > 1) {
            toxTableClean[, cname] = apply(toxTable[, cols], 1, function(x) {sum(as.numeric(x), na.rm = TRUE)})
          } else {
            toxTableClean[, cname] = toxTable[, cols]
          }

        } else {

          composition = as.numeric(strsplit(col, ",")[[1]])
          cols = paste0("tox.", side, ".", composition)
          cname = paste0("tox.", side, ".", paste0(composition, collapse = ""))
          if(length(composition) > 1) {
            toxTableClean[, cname] = apply(toxTable[, cols], 1, function(x) {sum(as.numeric(x), na.rm = TRUE)})
          } else {
            toxTableClean[, cols] = toxTable[, cols]
          }
        }
      }
    }
    toxTable = toxTableClean
  }





  # drop toxID as not needed after ordering
  toxTable$toxID = NULL

  # renaming
  colnames(toxTable)[1:2] = c("Category", "Toxicity")

  # return the table to the app
  return(toxTable)
}

# end




.toxTable_worst = function (toxData_Sub, rt, treatments) {

  # create table to populate
  toxTable = .toxTableSetup(length(treatments))
  dm = dim(toxTable)

  i = 0
  toxID = sort(unique(toxData_Sub$ass_toxID)) # note ass_toxID is generated by prepareToxicity
  for(tox in toxID){

    toxData_Sub2 = toxData_Sub[toxData_Sub$ass_toxID == tox,]
    i = i + 1
    # ID, category and name of toxicity
    toxTable[i,1:3] = c(tox, toxData_Sub2[1, rt@toxCategoryCol], toxData_Sub2[1, rt@toxNameCol])
    toxTable[i,4:dm[2]] = rep(0, length(treatments) * 5)

    # by treatment add data
    for(treatment in 1:length(treatments)) {
      toxData_Sub3 = toxData_Sub2[toxData_Sub2[,rt@treatmentCol] == treatments[treatment],]
      # aggregate for each patient taking the maximum grade
      if(dim(toxData_Sub3)[1]>0) {
        x = aggregate(toxData_Sub3[,rt@toxGradeCol], by = list(toxData_Sub3[,rt@patidCol]), FUN = max)$x
        toxTable[i,4:8 + (treatment - 1) * 5] = c(sum(x == 1), sum(x == 2), sum(x == 3), sum(x == 4), sum(x == 5))
      } else {
        toxTable[i,4:8 + (treatment - 1) * 5] = rep(0, 5)
      }
    }
  }

  return(toxTable)
}

.toxTable_all=function(toxData_Sub, rt, treatments){


  # create table to populate
  toxTable = .toxTableSetup(length(treatments))
  i=0
  toxID=sort(unique(toxData_Sub$ass_toxID))
  for (tox in toxID) {
    toxData_Sub2 = toxData_Sub[toxData_Sub$ass_toxID == tox, ]
    i = i + 1
    # ID, category and name of toxicity
    toxTable[i, 1:3] = c(tox, toxData_Sub2$ass_category[1], toxData_Sub2$ass_toxicity_disp[1])
    toxTable[i, 3 + 1:(length(treatments) * 5)] = 0
    # by treatment add data
    for (treatment in 1:length(treatments)) {
      toxData_Sub3 = toxData_Sub2[toxData_Sub2$treatment == treatments[treatment], ]
      # aggregate for each patient taking the maximum grade
      if (dim(toxData_Sub3)[1] > 0) {
        # add to table
        toxTable[i, 4:8 + (treatment - 1) * 5]=c(sum(toxData_Sub3$x == 1), sum(toxData_Sub3$x == 2), sum(toxData_Sub3$x == 3), sum(toxData_Sub3$x == 4), sum(toxData_Sub3$x == 5))
      } else {
        toxTable[i, 4:8 + (treatment-1) * 5]= rep(0, 5)
      }
    }
  }

  return(toxTable)
}



.toxTableSetup = function(noTreatments) {

  # create table to populate
  toxTable=data.frame(toxID=rep(0,1), category=rep("",1), toxicity=rep("",1), stringsAsFactors = FALSE)
  for(side in 1:noTreatments){
    toxTable[paste0("tox.", side,".1", sep = "")]= 0
    toxTable[paste0("tox.", side,".2", sep = "")]= 0
    toxTable[paste0("tox.", side,".3", sep = "")]= 0
    toxTable[paste0("tox.", side,".4", sep = "")]= 0
    toxTable[paste0("tox.", side,".5", sep = "")]= 0
  }
  return(toxTable[0,])
}
finite2/robustToxicities documentation built on May 16, 2019, 12:54 p.m.