updated

bhklab · Feb 7, 2017 · 6509af7 · 6509af7
1 parent ca2fd44
commit 6509af7
Show file tree

Hide file tree

Showing 10 changed files with 89 additions and 614 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -35,7 +35,6 @@ exportMethods(getExpDesignDF)
 exportMethods(getExperiment)
 exportMethods(getTimeVarData)
 exportMethods(getTreatment)
-exportMethods(getmRECIST)
 exportMethods(mapModelSlotIds)
 exportMethods(modelInfo)
 exportMethods(plotDrugResponse)

diff --git a/R/Gao2015_Data.R b/R/Gao2015_Data.R
@@ -1,40 +1,3 @@
-read_curveMetrics <- function()
-{
-
-  rd = readRDS("~/CXP/XG/Data/Gao_2015_NatureMed/nm.3954-S2_PCT_raw_data.Rda")
-  rdv = unique(rd[, c("Model","Tumor.Type")])
-  #naModID = dzv[is.na(dzv$Tumor.Type), "Model"]
-  #dzv[dzv$Model%in%naModID,]
-  ##--- remove NA
-  rdv = rdv[!is.na(rdv$Tumor.Type),]
-  ##--- read and merge the curve matrix ---------------------------------------
-  fl = "~/CXP/XG/Data/Gao_2015_NatureMed/nm.3954-S2_PCT_curve_metrics.Rda"
-  cvm = readRDS(fl)
-
-  cvm = merge(cvm, rdv, by.x = "Model", by.y = "Model")
-  pubLung = unique(cvm[cvm$Tumor.Type=="NSCLC", c("Model","Treatment")])
-  table(pubLung$Treatment)
-
-  data(pdxe)
-  dfx = getmRECIST(pdxe)
-  dfMap = mapModelSlotIds(object=pdxe, id=dfx$model.id, id.name="model.id",
-                          map.to="tumor.type", unique=TRUE)
-
-  dfx = merge(dfx, dfMap, by.x = "model.id", by.y = "model.id")
-  lungDf = dfx[dfx$tumor.type=="NSCLC",]
-
-  pubLung[!(pubLung$Model %in% lungDf$biobase.id),]
-
-  lungDf[!(lungDf$biobase.id %in% pubLung$Model), "biobase.id"]
-
-
-
-
-
-
-}
-
-
 
 processRawData <- function()
 {

diff --git a/R/mRECIST.R b/R/mRECIST.R
@@ -192,49 +192,49 @@ setMethod( f="setmRECIST<-",
            } )
 
 
-###===============================================================================================
-###===============================================================================================
-#' getmRECIST Generic
-#' Generic for getmRECIST method
+#' ###===============================================================================================
+#' ###===============================================================================================
+#' #' getmRECIST Generic
+#' #' Generic for getmRECIST method
+#' #'
+#' #' @examples
+#' #' data(pdxe)
+#' #' # calculate mRECIST for each experiment
+#' #' setmRECIST(pdxe)<- setmRECIST(pdxe)
+#' #' getmRECIST(pdxe, group.by="biobase.id")
+#' #' @param object The \code{XevaSet} to retrieve mRECIST from
+#' #' @param group.by The name of column which will be mapped to model.id
+#' #' @return a \code{data.frame} with the mRECIST values, rows are drugs and columns are model.id
+#' setGeneric(name = "getmRECIST", def = function(object, group.by="biobase.id") {standardGeneric("getmRECIST")} )
 #'
-#' @examples
-#' data(pdxe)
-#' # calculate mRECIST for each experiment
-#' setmRECIST(pdxe)<- setmRECIST(pdxe)
-#' getmRECIST(pdxe, group.by="biobase.id")
-#' @param object The \code{XevaSet} to retrieve mRECIST from
-#' @param group.by The name of column which will be mapped to model.id
-#' @return a \code{data.frame} with the mRECIST values, rows are drugs and columns are model.id
-setGeneric(name = "getmRECIST", def = function(object, group.by="biobase.id") {standardGeneric("getmRECIST")} )
-
-
-#' @export
-setMethod( f=getmRECIST,
-           signature="XevaSet",
-           definition= function(object, group.by)
-           {
-             rtx = data.frame(matrix(NA, nrow = length(object@experiment), ncol = 3))
-             colnames(rtx) = c("drug.join.name", "model.id", "mRECIST")
-             dfI = 1
-             for(I in object@experiment)
-             {
-               if(is.null(I$mRECIST))
-                 {
-                 msg = sprintf("mRECIST not present for model %s\nRun setmRECIST(object)<- setmRECIST(object) first\n", I$model.id)
-                 stop(msg)
-                 }
-              rtx[dfI, ] <- c(I$drug$join.name, I$model.id, I$mRECIST)
-              dfI = dfI+1
-             }
-             rownames(rtx)= NULL
-
-             ##----map to patient id -----------------
-             #rtx[, group.by] = subset(object@model, object@model$model.id %in% rtx$model.id)[,group.by]
-             rtx = merge(rtx, object@model[, c("model.id", group.by)], by.x = "model.id", by.y = "model.id")
-
-             dataColName = c(group.by, "model.id", "drug.join.name", "mRECIST")
-             rtx = BBmisc::sortByCol(rtx , dataColName, asc = rep(TRUE, length(dataColName)))
-             return(rtx[,dataColName])
-           }
-           )
+#'
+#' #' @export
+#' setMethod( f=getmRECIST,
+#'            signature="XevaSet",
+#'            definition= function(object, group.by)
+#'            {
+#'              rtx = data.frame(matrix(NA, nrow = length(object@experiment), ncol = 3))
+#'              colnames(rtx) = c("drug.join.name", "model.id", "mRECIST")
+#'              dfI = 1
+#'              for(I in object@experiment)
+#'              {
+#'                if(is.null(I$mRECIST))
+#'                  {
+#'                  msg = sprintf("mRECIST not present for model %s\nRun setmRECIST(object)<- setmRECIST(object) first\n", I$model.id)
+#'                  stop(msg)
+#'                  }
+#'               rtx[dfI, ] <- c(I$drug$join.name, I$model.id, I$mRECIST)
+#'               dfI = dfI+1
+#'              }
+#'              rownames(rtx)= NULL
+#'
+#'              ##----map to patient id -----------------
+#'              #rtx[, group.by] = subset(object@model, object@model$model.id %in% rtx$model.id)[,group.by]
+#'              rtx = merge(rtx, object@model[, c("model.id", group.by)], by.x = "model.id", by.y = "model.id")
+#'
+#'              dataColName = c(group.by, "model.id", "drug.join.name", "mRECIST")
+#'              rtx = BBmisc::sortByCol(rtx , dataColName, asc = rep(TRUE, length(dataColName)))
+#'              return(rtx[,dataColName])
+#'            }
+#'            )
 
diff --git a/R/plot_mRECIST.R b/R/plot_mRECIST.R
@@ -147,10 +147,28 @@ creatSideBarPlot <- function(mat, colPalette, splitBy=";", scaleRow=TRUE, scaleC
 
 }
 
+.mRcolPalette <- function(mr)
+{
+  # cp <- list("CR" = "#eff3ff", "CR-->PD" = "#9ecae1", "CR-->-->PD" = "#3182bd",
+  #            "PR" = "#d9ef8b", "PR-->PD" = "#91cf60", "PR-->-->PD" = "#1a9850",
+  #            "SD" = "#fed976", "SD-->PD" = "#ffeda0", "SD-->-->PD" = "#fed976",
+  #            "PD"= "#e41a1c")
+
+  #colPalette = list("CR" = "#4daf4a", "PR" = "#377eb8", "SD"= "#e41a1c", "PD"= "#984ea3")
+  #colPalette = list("CR" = "#377eb8", "PR" = "#4daf4a", "SD"= "#fec44f", "PD"= "#e41a1c")
+  cp <- list("CR" = "#0033CC", "CR-->PD" = "#3182bd", "CR-->-->PD" = "#bf8ef2",
+             "PR" = "#1a9850", "PR-->PD" = "#91cf60", "PR-->-->PD" = "#BFB35A",
+             "SD" = "#fed976", "SD-->PD" = "#ffeda0", "SD-->-->PD" = "#fed976",
+             "PD"= "#e41a1c")
+
+  colPal <- cp[mr]
+  return(colPal)
+}
 
 ##============================================================================
-#' Plot mRECIST for models and drugs
-#' \code{plot.mRECIST} plots the mRECIST
+#' To plot mRECIST values
+#'
+#' \code{plotmRECIST} plots the mRECIST matrix obtained from \code{summarizeResponse}
 #'
 #' @param object The \code{Xeva} dataset
 #' @param model.id The \code{model.id}
@@ -165,17 +183,30 @@ creatSideBarPlot <- function(mat, colPalette, splitBy=";", scaleRow=TRUE, scaleC
 #' @import ComplexHeatmap
 #' @import grid
 plotmRECIST <- function(mat, control.name = NA, control.col="green", drug.col="black",
-                        colPalette = list("CR" = "#377eb8", "PR" = "#4daf4a", "SD"= "#fec44f", "PD"= "#e41a1c"),
-                        name = "Drug & Models")
+                        colPalette = NULL, name = "Drug & Models")
 {
   control.name = c(control.name)
-  #mat = .castDataFram(df, row.var="drug.join.name", col.var = groupBy, value="mRECIST")
-  matRC = .sortPlotMat(mat, controlD=control.name, control.col=control.col, drug.col=drug.col)
-  mat = as.matrix(matRC$mat)
 
-  #colPalette = list("CR" = "#4daf4a", "PR" = "#377eb8", "SD"= "#e41a1c", "PD"= "#984ea3")
+  unqMat <- unique(unlist(lapply(colnames(mat), function(x) unique(mat[,x]) )))
+  unqMat <- unqMat[!is.na(unqMat)]
+
   if(is.null(colPalette))
-  { colPalette = list("CR" = "#377eb8", "PR" = "#4daf4a", "SD"= "#fec44f", "PD"= "#e41a1c") }
+  {
+    colPalette <- .mRcolPalette(unqMat)
+  } else
+  {
+    colPre <- sapply(unqMat, function(x) is.null(colPalette[[x]]))
+    if(any(colPre)==TRUE)
+    {
+      colAbName <- names(colPre[colPre==TRUE])
+      colAb <- paste(colAbName,collapse = "\n")
+      msg1 = sprintf("color for these values are not present in colPalette\n%s", colAb)
+      stop(msg1)
+    }
+  }
+
+  matRC = .sortPlotMat(mat, controlD=control.name, control.col=control.col, drug.col=drug.col)
+  mat = as.matrix(matRC$mat)
 
   nameSpc = unique(as.vector(as.matrix(mat)))
   backgroundCol = "gray"