xtld-utilities.R

subset.metadata.for.xtld.cv <- function(all.metadata, all.image.metadata) {
  # Only take data from the most frequently used scanner at each _Site_ (not dataset)
  freq.image.scanner.metadata <- find.most.frequent.scanner.within.group(all.image.metadata)
  metadata <- merge(all.metadata, freq.image.scanner.metadata, by.x = c("Image.file.name", "Site", "dataset"), by.y = c("image_id", "Site", "dataset"), all = FALSE)
  
  # Limit to LUSC and XTLD data from PDMR and MDACC
  metadata <- subset(metadata, Diagnosis %in% c("Xenograft associated B cell lymphomas", "Squamous cell lung carcinoma", "LUSC", "XTLD"))
  metadata <- subset(metadata, Site %in% c("PDMR", "MDACC"))
  
  # Our original analysis did not include PDMR/WGD dataset -- let's keep this to the original datasets, given how the folds
  # were defined (in the original analysis and we reuse them)
  metadata <- subset(metadata, dataset %in% c("mda_pt_pdx_mouse_amg", "mda_tc_pt_pdx", "pdmr", "pdmr-xtld"))
  
  # Limit to PDX
  metadata <- subset(metadata, Model.Type == "PDX")
  return(metadata)
}

load.data.for.xtld.cv <- function(all.metadata, all.image.metadata, data.file.col = "feature.file") {
  metadata <- subset.metadata.for.xtld.cv(all.metadata, all.image.metadata)
  load.data(metadata, data.file.col = data.file.col)
}

subset.data.for.xtld.cv <- function(tiles_data) {
  # Limit to tissue (as opposed to empty background) tiles
  tiles_data <- subset(tiles_data, tissue_area > 0.99)
  
  # Select one image per patient, taking the one with the max number of tiles.
  # Note that some MDACC patients have both XTLD and non-XTLD cases. 
  # In that case, favor XTLD.
  # Note that PDMR XTLD don't have associated Patient.IDs. 
  # So, we will keep those that are NA as well. We'll do that by giving them random names.
  flag <- is.na(tiles_data$Patient.ID) & (tiles_data$Diagnosis %in% c("Xenograft associated B cell lymphomas", "XTLD")) & (tiles_data$Site == "PDMR")
  print(table(flag))
  tiles_data[flag,"Patient.ID"] <- tiles_data[flag,"image_id"]
  flag <- is.na(tiles_data$Patient.ID)
  if(any(flag)) {
    stop("Was not expecting NA Patients except XTLD in PDMR")
  }
  
  # col <- "feature.file"
  col <- "image_id"
  images.to.keep <- 
    unlist(dlply(na.omit(tiles_data[, c("Patient.ID", col, "Diagnosis")]), .variables = c("Patient.ID"),
                 .fun = function(df) {
                   if(any(c("XTLD", "Xenograft associated B cell lymphomas") %in% df$Diagnosis)) {
                     df <- subset(df, Diagnosis %in% c("Xenograft associated B cell lymphomas", "XTLD"))
                   }
                   freq.tbl <- table(df[,col])
                   most.freq <- names(freq.tbl)[which.max(as.vector(freq.tbl))]
                   most.freq
                 }))
  
  # images.to.keep <- unique(c(images.to.keep, unique(tiles_data[is.na(tiles_data$Patient.ID), col])))

  flag <- tiles_data[, col] %in% images.to.keep
  tiles_data <- tiles_data[flag, ]
  return(tiles_data)
}

define.xtld.folds.and.weights <- function(tiles_data, fold_file, n.folds = 5, seed = 4321) {
  if(!file.exists(fold_file)) {
    cat("Defining folds and weights")
    un <- unique(tiles_data[, c("Diagnosis", "Patient.ID", "Site")])
    folds <- 
      ddply(un, .variables = c("Site"),
            .fun = function(df) {
              set.seed(seed)
              df.folds <- createFolds(factor(df$Diagnosis),k = n.folds)
              ldply(df.folds, .fun = function(fold) df[fold,])
            })
    colnames(folds)[1] <- "fold"
    tmp <- tiles_data[, c("minx", "maxx", "miny", "maxy", "tile", "image_id", "Diagnosis", "Patient.ID", "Site", "dataset")]
    folds <- merge(tmp, folds)
    
    
    # within each fold, weight tiles equally ...
    # across Sites ...
    # across diagnoses within datasets ...
    
    folds <-
      ddply(folds, .variables = c("fold"),
            .fun = function(df.fold) {
              ret <- ddply(df.fold, .variables = c("image_id", "Site", "Diagnosis"), 
                           .fun = function(df.fold.sub) { data.frame(num.tiles = nrow(df.fold.sub))})
              df.fold <- merge(df.fold, ret)
              df.fold
            })
    
    folds <-
      ddply(folds, .variables = c("fold"),
            .fun = function(df.fold) {
              ret <- ddply(unique(df.fold[, c("image_id", "Site", "Diagnosis")]), .variables = c("Site", "Diagnosis"), 
                           .fun = function(df.fold.sub) { data.frame(num.patients = nrow(df.fold.sub))})
              df.fold <- merge(df.fold, ret)
              df.fold
            })
    
    folds <-
      ddply(folds, .variables = c("fold"),
            .fun = function(df.fold) {
              ret <- ddply(unique(df.fold[, c("Site", "Diagnosis")]), .variables = c("Diagnosis"), 
                           .fun = function(df.fold.sub) { data.frame(num.sites = nrow(df.fold.sub))})
              df.fold <- merge(df.fold, ret)
              df.fold
            })
    
    folds <-
      ddply(folds, .variables = c("fold"),
            .fun = function(df.fold) {
              df.fold$num.diagnoses <- length(unique(df.fold$Diagnosis))
              df.fold$total.weight <- (1 / df.fold$num.diagnoses) * (1 / df.fold$num.sites) * (1 / df.fold$num.patients) * (1 / df.fold$num.tiles)
              df.fold
            })
    write.table(file = fold_file, folds, sep=",", row.names=FALSE, col.names=TRUE, quote = FALSE)
  } else {
    cat("Fold and weight file already saved; retrieving it\n")
  }
  folds <- read.table(fold_file, sep=",", header=TRUE)
  
  eps <- 0.001
  
  # Within a fold, total weight should be the same for each diagnosis
  d_ply(folds, .variables = c("fold"),
        .fun = function(df.fold) {
          tot <- ddply(df.fold,
                       .variables = c("Diagnosis"),
                       .fun = function(df.sub) {
                         data.frame(tot = sum(df.sub$total.weight))
                       })
          if(!similar.values(tot$tot, tot[1,"tot"])) { stop(paste0("Got dissimilar weights across diagnoses"))}
        })
  
  # Within a fold and diagnosis, total weight should be the same for each site
  d_ply(folds, .variables = c("fold", "Diagnosis"),
        .fun = function(df.fold) {
          tot <- ddply(df.fold,
                       .variables = c("Site"),
                       .fun = function(df.sub) {
                         data.frame(tot = sum(df.sub$total.weight))                         
                       })
          if(!similar.values(tot$tot, tot[1,"tot"])) { stop(paste0("Got dissimilar weights across sites")) }
        })
  
  # Within a fold, diagnosis, and site, total weight should be the same for each patient / image_id
  d_ply(folds, .variables = c("fold", "Diagnosis", "Site"),
        .fun = function(df.fold) {
          tot <- ddply(df.fold,
                       .variables = c("Patient.ID"),
                       .fun = function(df.sub) {
                         data.frame(tot = sum(df.sub$total.weight))
                       })
          if(!similar.values(tot$tot, tot[1,"tot"])) { stop(paste0("Got dissimilar weights across patients"))}          
        })
  
  # Within a fold, diagnosis, site, and patient / image_id, total weight should be the same for each tile
  d_ply(folds, .variables = c("fold", "Diagnosis", "Site", "Patient.ID"),
        .fun = function(df.fold) {
          if(!similar.values(df.fold$total.weight, df.fold[1,"total.weight"])) { stop(paste0("Got dissimilar weights across tiles"))}
        })
  
  return(folds)
}

define.xtld.folds <- function(tiles_data, fold_file, n.folds = 5, seed = 4321) {
  define.folds(tiles_data, fold_file, n.folds = n.folds, seed = seed)
}


define.xtld.weights <- function(df) {
  # within each dataframe (e.g., representing 4 of 5 folds), weight tiles equally ...
  # across Sites ...
  # across diagnoses within datasets ...
  
  img.var <- "image_id"
  img.var <- "Patient.ID"
  ret <-
    ddply(df, .variables = c(img.var, "Site", "Diagnosis"), 
          .fun = function(df.sub) { data.frame(num.tiles = nrow(df.sub))})
  df <- merge(ret, df)
  
  ret <-
    ddply(unique(df[, c(img.var, "Site", "Diagnosis")]), .variables = c("Site", "Diagnosis"), 
          .fun = function(df.sub) { data.frame(num.patients = nrow(df.sub))})
  df <- merge(ret, df)
  
  ret <-
    ddply(unique(df[, c("Site", "Diagnosis")]), .variables = c("Diagnosis"), 
          .fun = function(df.sub) { data.frame(num.sites = nrow(df.sub))})
  df <- merge(ret, df)
  
  df$num.diagnoses <- length(unique(df$Diagnosis))
  df$total.weight <- (1 / df$num.diagnoses) * (1 / df$num.sites) * (1 / df$num.patients) * (1 / df$num.tiles)
  
  eps <- 0.001
  
  # Total weight should be the same for each diagnosis
  tot <- ddply(df,
               .variables = c("Diagnosis"),
               .fun = function(df.sub) {
                 data.frame(tot = sum(df.sub$total.weight))
               })
  if(!similar.values(tot$tot, tot[1,"tot"])) { stop(paste0("Got dissimilar weights across diagnoses"))}
  
  # Within a diagnosis, total weight should be the same for each site
  d_ply(df, .variables = c("Diagnosis"),
        .fun = function(df.outer) {
          tot <- ddply(df.outer,
                       .variables = c("Site"),
                       .fun = function(df.sub) {
                         data.frame(tot = sum(df.sub$total.weight))                         
                       })
          if(!similar.values(tot$tot, tot[1,"tot"])) { stop(paste0("Got dissimilar weights across sites")) }
        })
  
  # Withi a diagnosis and site, total weight should be the same for each patient / image_id
  d_ply(df, .variables = c("Diagnosis", "Site"),
        .fun = function(df.outer) {
          tot <- ddply(df.outer,
                       .variables = c("Patient.ID"),
                       .fun = function(df.sub) {
                         data.frame(tot = sum(df.sub$total.weight))
                       })
          if(!similar.values(tot$tot, tot[1,"tot"])) { stop(paste0("Got dissimilar weights across patients"))}        
        })
  
  # diagnosis, site, and patient / image_id, total weight should be the same for each tile
  d_ply(df, .variables = c("Diagnosis", "Site", "Patient.ID"),
        .fun = function(df.outer) {
          if(!similar.values(df.outer$total.weight, df.outer[1,"total.weight"])) { stop(paste0("Got dissimilar weights across tiles"))}
        })
  
  return(df)
}