Skip to content

Commit

Permalink
New function to plot PDX data. Function for waterfall plot
Browse files Browse the repository at this point in the history
  • Loading branch information
@spocks
spocks committed Feb 10, 2017
1 parent 304b6f9 commit 0110646
Show file tree
Hide file tree
Showing 15 changed files with 504 additions and 360 deletions.
5 changes: 3 additions & 2 deletions NAMESPACE
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,15 +4,17 @@ S3method(print,XevaSet)
export()
export(.convertListToDataFram)
export(.rbindListOfDataframs)
export(NewPlotFunction)
export(computemRECIST)
export(creatXevaSet)
export(drugWaterfall)
export(experimentDesignSummary)
export(getExpDesign)
export(getModels)
export(getMolecularProfiles)
export(pasteColTogather)
export(pasteWithoutNA)
export(plotBatch)
export(plotModelErrorBar)
export(plotTreatmentControl)
export(plotmRECIST)
export(summarizeResponse)
Expand All @@ -37,7 +39,6 @@ exportMethods(getTimeVarData)
exportMethods(getTreatment)
exportMethods(mapModelSlotIds)
exportMethods(modelInfo)
exportMethods(plotDrugResponse)
exportMethods(selectModelIds)
exportMethods(setAngle)
exportMethods(setSlop)
Expand Down
30 changes: 28 additions & 2 deletions R/access_slot_expDesign.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -372,14 +372,18 @@ setMethod( f=getExpDesignDF,
#' @param object The \code{Xeva} dataset
#' @param ExpDesign A list with batch.name, treatment and control
#' @param var Name of the variable, default \code{volume}
#' @param drug.name \code{FALSE}. If \code{TRUE} will return drug name also
#' @return a \code{data.fram} with treatment, control and batch.name
setGeneric(name = "getTimeVarData", def = function(object, ExpDesign, var = "volume", treatment.only=FALSE)
setGeneric(name = "getTimeVarData",
def = function(object, ExpDesign, var = "volume",
treatment.only=FALSE, drug.name=FALSE)
{standardGeneric("getTimeVarData")} )

#' @export
setMethod( f=getTimeVarData,
signature=c(object="XevaSet"),
definition= function(object, ExpDesign, var = "volume", treatment.only=FALSE)
definition= function(object, ExpDesign, var = "volume",
treatment.only=FALSE, drug.name=FALSE)
{
if(is.null(ExpDesign$treatment) & is.null(ExpDesign$control))
{stop("treatment and control both NULL")}
Expand All @@ -392,6 +396,16 @@ setMethod( f=getTimeVarData,
trDF = .collapseRplicate(trLs, var = var)
trDF$exp.type = "treatment"
trDF$batch.name = ExpDesign$batch.name
if(drug.name==TRUE)
{
drugAll = sort(unique(unlist(lapply(trLs, "[[", "drug.join.name" ))))
if(length(drugAll)>1)
{
msg <- sprintf("multipal drugs for batch, will colleps by ;")
warning(msg)
}
trDF$drug.name <- paste(drugAll, collapse = ";")
}
}

if(!is.null(ExpDesign$control))
Expand All @@ -400,6 +414,18 @@ setMethod( f=getTimeVarData,
cnDF = .collapseRplicate(cnLs, var = var)
cnDF$exp.type = "control"
cnDF$batch.name = ExpDesign$batch.name

if(drug.name==TRUE)
{
drugAll = sort(unique(unlist(lapply(cnLs, "[[", "drug.join.name" ))))
if(length(drugAll)>1)
{
msg <- sprintf("multipal drugs for batch, will colleps by ;")
warning(msg)
}
cnDF$drug.name <- paste(drugAll, collapse = ";")
}

}

rdf = rbind(trDF, cnDF)
Expand Down
2 changes: 2 additions & 0 deletions R/access_slot_model.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -58,6 +58,8 @@ setMethod( f="modelInfo<-",
#' @examples
#' data(pdxe)
#' mapModelSlotIds(object=pdxe, id="X-007", id.name="biobase.id", map.to="model.id")
#' ##map batch ids
#' mapModelSlotIds(pdxe, id= "X-011.INC280", id.name = "batch.name", map.to = "tumor.type")
#' @param object The \code{Xeva} dataset
#' @param id The \code{id}
#' @param id.name The \code{id} name
Expand Down
213 changes: 102 additions & 111 deletions R/calculate_angle_functions.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,6 @@
.computSlopFun <- function(x,y, log.y=TRUE)
{
#fit = lm(y~x)

if(log.y==TRUE)
{y = log(y)}

Expand All @@ -22,107 +21,106 @@
return(list(fit=fit, angel=ang, data=data))
}


.plotAngelAndFit <- function(dfT, dfC, fitT, fitC)
{
xrng = range(dfT$time, dfC$time)
yrng = range(dfT$mean, dfC$mean)
opar <- par() # make a copy of current settings
par(pty="s", xpd=TRUE)
plot(dfT$time, dfT$mean, col="red", pch=19,
xlab = "time", ylab = "tumor volume",
xlim = xrng, ylim = yrng)
points(dfC$time, dfC$mean, col="blue", pch=19)

legend("bottomright", inset=c(-0.38,0),
legend=c("Treatment", "Control"), fill=c("red", "blue"), cex=0.8)

par(xpd=FALSE);

#nd = predict(fit, newdata = list(x=0))+q
#.testPlot(x,y, nmod)
#abline(nd, coef(nmod), col='blue')
lxT = predict(fitT$fit, newdata = list(x=0))+dfT$mean[1]
abline(lxT, coef(fitT$fit), col="red")

lxC = predict(fitC$fit, newdata = list(x=0))+dfC$mean[1]
abline(lxC, coef(fitC$fit), col="blue")

#abline(fitT$fit, col="red"); abline(fitC$fit, col="blue")


par(pty=opar$pty, xpd=opar$xpd) ## reset par to old setting
}


####-----------------------------------------------------------
plot_Batch_angel <- function(dt.fit, dc.fit, fitC, fitT, dfC, dfT, title="plot")
{
xrng = range(sapply(dt.fit, function(i) range(i$data$x)),
sapply(dc.fit, function(i) range(i$data$x)))

yrng = range(sapply(dt.fit, function(i) range(i$data$y)),
sapply(dc.fit, function(i) range(i$data$y)))

opar <- par() # make a copy of current settings
par(pty="s", xpd=TRUE)
plot(NA, col="red", pch=19, main=title,
xlab = "time", ylab = "tumor volume",
xlim = xrng, ylim = yrng)

.plt1Mod <- function(d.fit, col){
for(dfX in d.fit)
{
#points(dfX$data$x, dfX$data$y, col="blue", pch=19)
#lx = predict(dfX$fit, newdata = list(x=0))+dfX$data$y[1]
#abline(lx, coef(dfX$fit), col="blue")
lines(dfX$data$x, dfX$data$y, col=col,type="b", lty=3, pch=19)
} }

.plt1Mod(dc.fit, col = "#6baed6")
.plt1Mod(dt.fit, col = "#fc8d59")

##----- add line ------
if(1==2){
dfX =dc.fit[[5]]
points(dfX$data$x, dfX$data$y, col="blue", pch=19)
lx = predict(dfX$fit, newdata = list(x=0))+dfX$data$y[1]
yl = coef(dfX$fit)
#avgAng = mean(sapply(dc.fit, "[[", "angel"))
avgAng = mean(sapply(dc.fit, function(x)coef(x$fit)))
yv = c(avgAng*xrng[1], avgAng*xrng[2])
lines(xrng, yv, col="red")
#lx1 = predict(dfX$fit, newdata = list(x=xrng[1]))+dfX$data$y[1]
#lx2 = predict(dfX$fit, newdata = list(x=xrng[2]))+dfX$data$y[1]
#abline(lx, coef(dfX$fit), col="blue")
#lines(c(0,110), c(4.006887*0+lx, 4.006887*110+lx), col="red")
}

legend("bottomright", inset=c(-0.38,0),
legend=c("Treatment", "Control"),
fill=c("#a50f15", "#081d58"), cex=0.8)

par(xpd=FALSE)

tPoint0 = mean(sapply(dt.fit, function(i) i$data$y[1]))

lxT = predict(fitT$fit, newdata = list(x=0))+ tPoint0 # dfT$y[1]
abline(lxT, coef(fitT$fit), col="#a50f15")

cPoint0 = mean(sapply(dc.fit, function(i) i$data$y[1]))
lxC = predict(fitC$fit, newdata = list(x=0))+ cPoint0 # dfC$y[1]
abline(lxC, coef(fitC$fit), col="#081d58")

par(pty=opar$pty, xpd=opar$xpd)

}

##--------------------------------------------------------------------
#
# .plotAngelAndFit <- function(dfT, dfC, fitT, fitC)
# {
# xrng = range(dfT$time, dfC$time)
# yrng = range(dfT$mean, dfC$mean)
# opar <- par() # make a copy of current settings
# par(pty="s", xpd=TRUE)
# plot(dfT$time, dfT$mean, col="red", pch=19,
# xlab = "time", ylab = "tumor volume",
# xlim = xrng, ylim = yrng)
# points(dfC$time, dfC$mean, col="blue", pch=19)
#
# legend("bottomright", inset=c(-0.38,0),
# legend=c("Treatment", "Control"), fill=c("red", "blue"), cex=0.8)
#
# par(xpd=FALSE);
#
# #nd = predict(fit, newdata = list(x=0))+q
# #.testPlot(x,y, nmod)
# #abline(nd, coef(nmod), col='blue')
# lxT = predict(fitT$fit, newdata = list(x=0))+dfT$mean[1]
# abline(lxT, coef(fitT$fit), col="red")
#
# lxC = predict(fitC$fit, newdata = list(x=0))+dfC$mean[1]
# abline(lxC, coef(fitC$fit), col="blue")
#
# #abline(fitT$fit, col="red"); abline(fitC$fit, col="blue")
#
#
# par(pty=opar$pty, xpd=opar$xpd) ## reset par to old setting
# }
#
#
# ####-----------------------------------------------------------
# plot_Batch_angel <- function(dt.fit, dc.fit, fitC, fitT, dfC, dfT, title="plot")
# {
# xrng = range(sapply(dt.fit, function(i) range(i$data$x)),
# sapply(dc.fit, function(i) range(i$data$x)))
#
# yrng = range(sapply(dt.fit, function(i) range(i$data$y)),
# sapply(dc.fit, function(i) range(i$data$y)))
#
# opar <- par() # make a copy of current settings
# par(pty="s", xpd=TRUE)
# plot(NA, col="red", pch=19, main=title,
# xlab = "time", ylab = "tumor volume",
# xlim = xrng, ylim = yrng)
#
# .plt1Mod <- function(d.fit, col){
# for(dfX in d.fit)
# {
# #points(dfX$data$x, dfX$data$y, col="blue", pch=19)
# #lx = predict(dfX$fit, newdata = list(x=0))+dfX$data$y[1]
# #abline(lx, coef(dfX$fit), col="blue")
# lines(dfX$data$x, dfX$data$y, col=col,type="b", lty=3, pch=19)
# } }
#
# .plt1Mod(dc.fit, col = "#6baed6")
# .plt1Mod(dt.fit, col = "#fc8d59")
#
# ##----- add line ------
# if(1==2){
# dfX =dc.fit[[5]]
# points(dfX$data$x, dfX$data$y, col="blue", pch=19)
# lx = predict(dfX$fit, newdata = list(x=0))+dfX$data$y[1]
# yl = coef(dfX$fit)
# #avgAng = mean(sapply(dc.fit, "[[", "angel"))
# avgAng = mean(sapply(dc.fit, function(x)coef(x$fit)))
# yv = c(avgAng*xrng[1], avgAng*xrng[2])
# lines(xrng, yv, col="red")
# #lx1 = predict(dfX$fit, newdata = list(x=xrng[1]))+dfX$data$y[1]
# #lx2 = predict(dfX$fit, newdata = list(x=xrng[2]))+dfX$data$y[1]
# #abline(lx, coef(dfX$fit), col="blue")
# #lines(c(0,110), c(4.006887*0+lx, 4.006887*110+lx), col="red")
# }
#
# legend("bottomright", inset=c(-0.38,0),
# legend=c("Treatment", "Control"),
# fill=c("#a50f15", "#081d58"), cex=0.8)
#
# par(xpd=FALSE)
#
# tPoint0 = mean(sapply(dt.fit, function(i) i$data$y[1]))
#
# lxT = predict(fitT$fit, newdata = list(x=0))+ tPoint0 # dfT$y[1]
# abline(lxT, coef(fitT$fit), col="#a50f15")
#
# cPoint0 = mean(sapply(dc.fit, function(i) i$data$y[1]))
# lxC = predict(fitC$fit, newdata = list(x=0))+ cPoint0 # dfC$y[1]
# abline(lxC, coef(fitC$fit), col="#081d58")
#
# par(pty=opar$pty, xpd=opar$xpd)
#
# }
#
# ##--------------------------------------------------------------------

#' @import ggplot2
plot_Batch_angel_ggplot <- function(dt.fit, dc.fit, fitC, fitT, title="plot")
{

##-----make one DF ----------------------------------------
dft = do.call(rbind, lapply(names(dt.fit), function(n)
{d=dt.fit[[n]]$data; d$model.id=n; d } ))
Expand All @@ -140,14 +138,14 @@ plot_Batch_angel_ggplot <- function(dt.fit, dc.fit, fitC, fitT, title="plot")
plt <- plt + scale_color_manual(values=tcCol)

##-------add lm line -----------------------------------------------------------
addLMfitLines <- function(plt, fit, p0, color="black")
.addLMfitLines <- function(plt, fit, p0, color="black")
{
lx = predict(fit, newdata = list(x=0))+ p0
plt + geom_abline(intercept = lx, slope = coef(fit)[1], color=color)
}

plt <- addLMfitLines(plt, fit = fitC$fit, p0= fitC$data$y[1], color="blue")
plt <- addLMfitLines(plt, fit = fitT$fit, p0= fitT$data$y[1], color="red")
plt <- .addLMfitLines(plt, fit = fitC$fit, p0= fitC$data$y[1], color="blue")
plt <- .addLMfitLines(plt, fit = fitT$fit, p0= fitT$data$y[1], color="red")
##-------------------------------------------------------------------------------
plt <- plt + theme(aspect.ratio=1)
plt <- .ggplotEmptyTheme(plt)
Expand All @@ -158,11 +156,6 @@ plot_Batch_angel_ggplot <- function(dt.fit, dc.fit, fitC, fitT, title="plot")
return(plt)
}






####-----------------------------------------------------------
#' data(lpdx); object=lpdx
#' expDegI <- expDesign(lpdx, "PHLC111_P7")
Expand Down Expand Up @@ -193,7 +186,6 @@ computAngelFor1ExpDesign <- function(object, expDegI, var="volume", treatment.on

DFx = getTimeVarData(object, expDegI, var=var, treatment.only=treatment.only)


dfC = DFx[DFx$exp.type=="control",]
dfT = DFx[DFx$exp.type=="treatment",]

Expand Down Expand Up @@ -239,10 +231,9 @@ computAngelFor1ExpDesign <- function(object, expDegI, var="volume", treatment.on
#' @examples
#' data(pdxe)
#' # creat a experiment desing
#' ExpDesign = list(batch.name="myBatch", treatment=c("X.015.BY19"), control=c("X.015.uned"))
#' angl = calculateAngle(object=pdxe, ExpDesign, var = "volume", treatment.only=TRUE, plot=TRUE)
#' #print angle
#' print(angl$angle)
#' myDesign = list(batch.name="myBatch", treatment=c("X.015.BY19"), control=c("X.015.uned"))
#' angl = calculateAngle(object=pdxe, myDesign, var = "volume", treatment.only=TRUE, plot=TRUE)
#' print(angl$myBatch$angle)
#' #print plot
#' print(angl$myBatch$plot)
#' #print without legend
Expand Down
Loading

0 comments on commit 0110646

Please sign in to comment.