Skip to content

Commit

Permalink
Merge pull request #154 from bhklab/devel
Browse files Browse the repository at this point in the history 
chore: add magicaxis function back
  • Loading branch information
@jjjermiah
jjjermiah authored Feb 2, 2024
2 parents 573cd93 + c4c46c6 commit 43cadc9
Show file tree
Hide file tree
Showing 2 changed files with 6 additions and 278 deletions.
8 changes: 5 additions & 3 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
@@ -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="[email protected]",
role=c("aut")),
person(given="Christopher", family="Eeles",
email="[email protected]", role=c("aut")),
person(given="Jermiah", family="Joseph",
email="[email protected]", 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="[email protected]", role=c("aut")),
person(given="Jermiah", family="Joseph", email="[email protected]", role=c("aut")),
person("Benjamin", "Haibe-Kains", email="[email protected]", role=c("aut", "cre"))
)
Description: Contains a set of functions to perform large-scale analysis of
Expand Down Expand Up @@ -39,6 +40,7 @@ Imports:
BiocParallel,
ggplot2,
RColorBrewer,
magicaxis,
parallel,
caTools,
methods,
Expand Down
276 changes: 1 addition & 275 deletions R/drugDoseResponseCurve.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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) {
Expand Down Expand Up @@ -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[2]){labloc=c(labloc,max(labloc)+1)}
labloc=round(labloc,10)
labloc=powbase^labloc
tickloc=labloc
}
if(usemultloc){
labloc={}
for(i in 1:length(multloc)){labloc=c(labloc,multloc[i]*powbase^seq(ceiling(log(lims[1],powbase))-1,floor(log(lims[2],powbase))+1))}
labloc=sort(labloc)
tickloc={}
for(i in 1:9){tickloc=c(tickloc,i*powbase^seq(ceiling(log(lims[1],powbase))-1,floor(log(lims[2],powbase))+1))}
tickloc=sort(tickloc)
}
#annoyingly I get weird issues for some numbers (e.g 0.00035) if they are in an otherwise scientific format list, and this behaves differently to the formatting on the actual plots. Only way round this is to format each number individually.
char={}
if(exptext){for(i in 1:length(labloc)){char=c(char,format(labloc[i]))}}
if(! exptext){for(i in 1:length(labloc)){char=c(char,format(log(labloc[i],powbase)))}}
}else{
labloc=labloc*(prettybase/10)
tickloc=labloc
char={}
for(i in 1:length(labloc)){char=c(char,format(labloc[i]))}
}

if(log & usemultloc==F){lims=powbase^(lims)}
if(trim){
char=char[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))
}

0 comments on commit 43cadc9

Please sign in to comment.