diff --git a/DESCRIPTION b/DESCRIPTION index a4bd080..623ac2e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,17 +1,18 @@ Package: PharmacoGx Type: Package Title: Analysis of Large-Scale Pharmacogenomic Data -Version: 3.7.1 -Date: 2023-04-19 +Version: 3.7.2 +Date: 2024-02-02 Authors@R: c( person(given="Petr", family="Smirnov", email="petr.smirnov@uhnresearch.ca", role=c("aut")), person(given="Christopher", family="Eeles", email="christopher.eeles@uhnresearch.ca", role=c("aut")), + person(given="Jermiah", family="Joseph", + email="jermiah.joseph@uhn.ca", role=c("aut")), person(given="Zhaleh", family="Safikhani", role=c("aut")), person(given="Mark", family="Freeman", role=c("aut")), person(given="Feifei", family="Li", email="ff.li@mail.utoronto.ca", role=c("aut")), - person(given="Jermiah", family="Joseph", email="jermiah.joseph@uhn.ca", role=c("aut")), person("Benjamin", "Haibe-Kains", email="benjamin.haibe.kains@utoronto.ca", role=c("aut", "cre")) ) Description: Contains a set of functions to perform large-scale analysis of @@ -39,6 +40,7 @@ Imports: BiocParallel, ggplot2, RColorBrewer, + magicaxis, parallel, caTools, methods, diff --git a/R/drugDoseResponseCurve.R b/R/drugDoseResponseCurve.R index 29d341f..d5385f3 100755 --- a/R/drugDoseResponseCurve.R +++ b/R/drugDoseResponseCurve.R @@ -298,8 +298,7 @@ function(drug, } plot(NA, xlab="Concentration (uM)", ylab="% Viability", axes =FALSE, main=title, log="x", ylim=viability.range, xlim=dose.range, cex=cex, cex.main=cex.main) - # magicaxis::magaxis(side=seq_len(2), frame.plot=TRUE, tcl=-.3, majorn=c(5,3), minorn=c(5,2)) - .magaxis(side=seq_len(2), frame.plot=TRUE, tcl=-.3, majorn=c(5,3), minorn=c(5,2)) + magicaxis::magaxis(side=seq_len(2), frame.plot=TRUE, tcl=-.3, majorn=c(5,3), minorn=c(5,2)) legends <- NULL legends.col <- NULL if (length(doses) > 1) { @@ -335,276 +334,3 @@ function(drug, return(invisible(NULL)) } - -# TODO:: REMOVE FUNCTION WHEN MAGIC AXIS GETS RETURNED -#' @keywords internal -.magaxis <- function(side=1:2, majorn=5, minorn='auto', tcl=0.5, ratio=0.5, labels=TRUE, unlog='auto', - mgp=c(2,0.5,0), mtline=2, xlab=NULL, ylab=NULL, crunch=TRUE, logpretty=TRUE, - prettybase=10, powbase=10, hersh=FALSE, family='sans', frame.plot=FALSE, - usepar=FALSE, grid=FALSE, grid.col='grey', grid.lty=1, grid.lwd=1, axis.lwd=1, - ticks.lwd=axis.lwd, axis.col='black', do.tick=TRUE, ...){ - dots=list(...) - dotskeepaxis=c('cex.axis', 'col.axis', 'font.axis', 'xaxp', 'yaxp', 'tck', 'las', 'fg', 'xpd', 'xaxt', 'yaxt', 'col.ticks') - dotskeepmtext=c('cex.lab', 'col.lab', 'font.lab') - if(length(dots)>0){ - dotsaxis=dots[names(dots) %in% dotskeepaxis] - dotsmtext=dots[names(dots) %in% dotskeepmtext] - }else{ - dotsaxis={} - dotsmtext={} - } - if(length(mtline)==1){mtline=rep(mtline,2)} - majornlist=majorn - minornlist=minorn - labelslist=labels - unloglist=unlog - crunchlist=crunch - logprettylist=logpretty - prettybaselist=prettybase - powbaselist=powbase - gridlist=grid - if(length(majorn)==1 & length(side)>1){majornlist=rep(majorn,length(side))} - if(length(minorn)==1 & length(side)>1){minornlist=rep(minorn,length(side))} - if(length(labels)==1 & length(side)>1){labelslist=rep(labels,length(side))} - if(length(unlog)==1 & length(side)>1 & (unlog[1]==T | unlog[1]==F | unlog[1]=='auto')){unloglist=rep(unlog,length(side))} - if(length(crunch)==1 & length(side)>1){crunchlist=rep(crunch,length(side))} - if(length(logpretty)==1 & length(side)>1){logprettylist=rep(logpretty,length(side))} - if(length(prettybase)==1 & length(side)>1){prettybaselist=rep(prettybase,length(side))} - if(length(powbase)==1 & length(side)>1){powbaselist=rep(powbase,length(side))} - if(length(grid)==1 & length(side)>1){gridlist=rep(grid,length(side))} - - if(!all(is.logical(unlog)) & unlog[1]!='auto'){ - unlogsplit = strsplit(unlog[1],'')[[1]] - unloglist=rep(FALSE,length(side)) - if(unlog[1]==''){unloglist=rep(FALSE,length(side))} - if('x' %in% unlogsplit){unloglist[side %in% c(1,3)]=TRUE} - if('y' %in% unlogsplit){unloglist[side %in% c(2,4)]=TRUE} - #if(unlog[1]=='xy' | unlog[1]=='yx'){unloglist=rep(TRUE,length(side))} - } - - if(length(majornlist) != length(side)){stop('Length of majorn vector mismatches number of axes!')} - if(length(minornlist) != length(side)){stop('Length of minorn vector mismatches number of axes!')} - if(length(labelslist) != length(side)){stop('Length of labels vector mismatches number of axes!')} - if(length(unloglist) != length(side)){stop('Length of unlog vector mismatches number of axes!')} - if(length(crunchlist) != length(side)){stop('Length of crunch vector mismatches number of axes!')} - if(length(logprettylist) != length(side)){stop('Length of logpretty vector mismatches number of axes!')} - if(length(prettybaselist) != length(side)){stop('Length of prettybase vector mismatches number of axes!')} - if(length(powbaselist) != length(side)){stop('Length of powbase vector mismatches number of axes!')} - if(length(gridlist) != length(side)){stop('Length of grid vector mismatches number of axes!')} - - currentfamily=par('family') - if(hersh & family=='serif'){par(family='HersheySerif')} - if(hersh & family=='sans'){par(family='HersheySans')} - if(hersh==F & family=='serif'){par(family='serif')} - if(hersh==F & family=='sans'){par(family='sans')} - - if(missing(axis.lwd)){axis.lwd=par()$lwd} - if(missing(ticks.lwd)){ticks.lwd=par()$lwd} - - if(usepar){ - if(missing(tcl)){tcl=par()$tcl} - if(missing(mgp)){mgp=par()$mgp} - } - - for(i in 1:length(side)){ - currentside=side[i] - majorn=majornlist[i] - minorn=minornlist[i] - labels=labelslist[i] - unlog=unloglist[i] - crunch=crunchlist[i] - logpretty=logprettylist[i] - prettybase=prettybaselist[i] - powbase=powbaselist[i] - grid=gridlist[i] - lims=par("usr") - if(currentside %in% c(1,3)){ - lims=lims[1:2];if(par('xlog')){logged=T}else{logged=F} - }else{ - lims=lims[3:4];if(par('ylog')){logged=T}else{logged=F} - } - lims=sort(lims) - - if(unlog=='auto'){if(logged){unlog=T}else{unlog=F}} - if((logged | unlog) & powbase==10){usemultloc=(10^lims[2])/(10^lims[1])<50}else{usemultloc=F} - - if(unlog){ - sci.tick=.maglab(10^lims,n=majorn,log=T,exptext=T,crunch=crunch,logpretty=logpretty,usemultloc=usemultloc,prettybase=prettybase, powbase=powbase, hersh=hersh) - major.ticks = log(sci.tick$tickat,powbase) - uselabels = sci.tick$exp - labloc = log(sci.tick$labat,powbase) - if(usemultloc==F){ - if(minorn=='auto'){ - splitmin=(powbase^major.ticks[2])/(powbase^major.ticks[1]) - }else{ - splitmin=minorn+1 - } - if(splitmin>10){ - minors = seq(major.ticks[1], major.ticks[2])-major.ticks[1] - }else{ - minors = log(seq(powbase^major.ticks[1],powbase^major.ticks[2],len=splitmin),powbase)-major.ticks[1] - } - } - } - if(logged & unlog==F){ - sci.tick=.maglab(10^lims, n=majorn, log=T, exptext=F, crunch=crunch, logpretty=logpretty,usemultloc=usemultloc, prettybase=prettybase, powbase=powbase, hersh=hersh) - major.ticks = log(sci.tick$tickat,powbase) - uselabels = sci.tick$exp - labloc = log(sci.tick$labat,powbase) - if(usemultloc==F){ - if(minorn=='auto'){ - splitmin=(powbase^major.ticks[2])/(powbase^major.ticks[1]) - }else{ - splitmin=minorn+1 - } - if(splitmin>10){ - minors = seq(major.ticks[1], major.ticks[2])-major.ticks[1] - }else{ - minors = log(seq(powbase^major.ticks[1],powbase^major.ticks[2],len=splitmin),powbase)-major.ticks[1] - } - } - } - - if(logged==F & unlog==F){ - sci.tick=.maglab(lims,n=majorn,log=F,exptext=F,prettybase=prettybase, hersh=hersh) - major.ticks = sci.tick$tickat - uselabels = sci.tick$exp - labloc = sci.tick$labat - if(minorn=='auto'){splitmin=length(pretty(major.ticks[1:2]))}else{splitmin=minorn+1} - minors = seq(major.ticks[1],major.ticks[2],len=splitmin)-major.ticks[1] - } - - if(grid){ - if(currentside==1){ - if(logged){ - abline(v=powbase^labloc, col=grid.col, lty=grid.lty, lwd=grid.lwd) - }else{ - abline(v=labloc, col=grid.col, lty=grid.lty, lwd=grid.lwd) - } - } - if(currentside==2){ - if(logged){ - abline(h=powbase^labloc, col=grid.col, lty=grid.lty, lwd=grid.lwd) - }else{ - abline(h=labloc, col=grid.col, lty=grid.lty, lwd=grid.lwd) - } - } - } - - if(logged){ - do.call("axis", c(list(side=currentside,at=powbase^major.ticks,tcl=tcl,labels=FALSE,tick=do.tick,mgp=mgp,lwd=axis.lwd,lwd.ticks=ticks.lwd,col=axis.col),dotsaxis)) - }else{ - do.call("axis", c(list(side=currentside,at=major.ticks,tcl=tcl,labels=FALSE,tick=do.tick,mgp=mgp,lwd=axis.lwd,lwd.ticks=ticks.lwd,col=axis.col),dotsaxis)) - } - - if(labels){ - if(logged){ - do.call("axis", c(list(side=currentside,at=powbase^labloc,tick=F,labels=uselabels,mgp=mgp,lwd=axis.lwd,lwd.ticks=ticks.lwd,col=axis.col),dotsaxis)) - }else{ - do.call("axis", c(list(side=currentside,at=labloc,tick=F,labels=uselabels,mgp=mgp,lwd=axis.lwd,lwd.ticks=ticks.lwd,col=axis.col),dotsaxis)) - } - } - - if(usemultloc==F & minorn>1){ - minors = minors[-c(1,length(minors))] - minor.ticks = c(outer(minors, major.ticks, `+`)) - if(logged){ - do.call("axis", c(list(side=currentside,at=powbase^minor.ticks,tcl=tcl*ratio,labels=FALSE,tick=do.tick,mgp=mgp,lwd=axis.lwd,lwd.ticks=ticks.lwd,col=axis.col),dotsaxis)) - }else{ - do.call("axis", c(list(side=currentside,at=minor.ticks,tcl=tcl*ratio,labels=FALSE,tick=do.tick,mgp=mgp,lwd=axis.lwd,lwd.ticks=ticks.lwd,col=axis.col),dotsaxis)) - } - } - } - - if(length(dotsmtext)>0){ - names(dotsmtext)=c('cex', 'col', 'font')[match(names(dotsmtext), dotskeepmtext)] - } - if(is.null(xlab)==FALSE){ - do.call("mtext", c(list(text=xlab, side=ifelse(side[1] %in% c(1,3), side[1], side[2]), line=mtline[1]), dotsmtext)) - } - if(is.null(ylab)==FALSE){ - do.call("mtext", c(list(text=ylab, side=ifelse(side[2] %in% c(2,4), side[2], side[1]), line=mtline[2]), dotsmtext)) - } - - if(frame.plot){box()} - par(family=currentfamily) - } - - -#' @keywords internal -.maglab <- -function(lims, n, log=FALSE, exptext=TRUE, crunch=TRUE, logpretty=TRUE, usemultloc=FALSE, multloc=c(1,2,5), prettybase=10, powbase=10, hersh=FALSE, trim=FALSE){ -if(usemultloc & log==F){stop('If using multloc then log must be TRUE!')} -lims=lims/(prettybase/10) -if(log & usemultloc==F){lims=log(lims, powbase)} -if(usemultloc==F){if(missing(n)){labloc=pretty(lims)}else{labloc=pretty(lims,n)}} -if(log){ - if(usemultloc==F){ - labloc=labloc+log10(prettybase/10) - labloc=labloc[round(labloc -log(prettybase/10,powbase),10) %% 1==0] - if(min(labloc)>lims[1]){labloc=c(min(labloc)-1,labloc)} - if(max(labloc)=lims[1] & labloc<=lims[2]] -labloc=labloc[labloc>=lims[1] & labloc<=lims[2]] -tickloc=tickloc[tickloc>=lims[1] & tickloc<=lims[2]] -} - -check=grep('e',char) -if(length(check)>0){ - char=format(labloc,scientific=T) - check=grep("0e+00",char,fixed=T) - char[check]="0" - if(hersh){ - check=grep("e+0",char,fixed=T) - char[check]=sub('e+0','e+',char[check],fixed=T) - check=grep("e-0",char,fixed=T) - char[check]=sub('e-0','e-',char[check],fixed=T) - check=grep('e+',char,fixed=T) - char[check]=paste(sub('e+','\\mu10\\sp',char[check],fixed=T),'\\ep',sep='') - check=grep('e-',char,fixed=T) - char[check]=paste(sub('e-','\\mu10\\sp-',char[check],fixed=T),'\\ep',sep='') - }else{ - check=grep('e+',char,fixed=T) - char[check]=paste(sub('e+','*x*10^{',char[check],fixed=T),'}',sep='') - check=grep('e-',char,fixed=T) - char[check]=paste(sub('e-','*x*10^{-',char[check],fixed=T),'}',sep='') - } -} -if(crunch){ - check = grepl('1*x*',char, fixed=TRUE) & (! grepl('.1*x*',char, fixed=TRUE)) - if(length(check)>0){ - if(hersh){ - char[check]=sub('1\\mu','',char[check],fixed=T) - }else{ - char[check]=sub('1*x*','',char[check],fixed=T) - } - } -} -if(hersh){exp=char}else{exp=parse(text=char)} -return(list(tickat=tickloc,labat=labloc,exp=exp)) -} \ No newline at end of file