Merge pull request #153 from bhklab/devel

Devel

.github/workflows/R-CMD-check-bioc-release.yml

@@ -59,9 +59,9 @@ jobs:
         config:
           - {
             os: ubuntu-latest,
-            r: '4.2',
-            bioc: '3.16',
-            cont: "bioconductor/bioconductor_docker:RELEASE_3_16",
+            r: '4.4',
+            bioc: '3.19',
+            cont: 'bioconductor/bioconductor_docker:devel', #"bioconductor/bioconductor_docker:RELEASE_3_16",
             rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest",
             github: "bhklab/CoreGx@release"
             }

.github/workflows/R-CMD-check-bioc.yml

@@ -63,15 +63,15 @@ jobs:
         config:
           - {
             os: ubuntu-latest,
-            r: '4.3',
-            bioc: '3.17',
+            r: '4.4',
+            bioc: '3.19',
             cont: "bioconductor/bioconductor_docker:devel",
             rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest",
             github: "bhklab/CoreGx"
           }
           - { os: macOS-latest, r: '4.2', bioc: '3.16'}
           - { os: windows-latest, r: '4.2', bioc: '3.16'}
-
+          - { os: macOS-latest, r: '4.3', bioc: '3.18'}
     env:
       R_REMOTES_NO_ERRORS_FROM_WARNINGS: true
       RSPM: ${{ matrix.config.rspm }}

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: PharmacoGx
 Type: Package
 Title: Analysis of Large-Scale Pharmacogenomic Data
-Version: 3.3.4
+Version: 3.7.1
 Date: 2023-04-19
 Authors@R: c(
     person(given="Petr", family="Smirnov", email="petr.smirnov@uhnresearch.ca",
@@ -38,7 +38,6 @@ Imports:
     MultiAssayExperiment,
     BiocParallel,
     ggplot2,
-    magicaxis,
     RColorBrewer,
     parallel,
     caTools,
@@ -57,7 +56,7 @@ Imports:
 Depends: R (>= 3.6), CoreGx
 LinkingTo: Rcpp
 Roxygen: list(markdown = TRUE, r6=FALSE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 VignetteBuilder: knitr
 VignetteEngine: knitr::rmarkdown
 biocViews: GeneExpression, Pharmacogenetics, Pharmacogenomics, Software, Classification

NAMESPACE

@@ -3,7 +3,6 @@
 S3method(plot,PharmacoSig)
 export("drugInfo<-")
 export("drugNames<-")
-export()
 export(.computeAUCUnderFittedCurve)
 export(.computeZIPdelta)
 export(.deltaScore)
@@ -192,7 +191,6 @@ importFrom(graphics,lines)
 importFrom(graphics,plot)
 importFrom(graphics,points)
 importFrom(graphics,rect)
-importFrom(magicaxis,magaxis)
 importFrom(methods,callNextMethod)
 importFrom(reshape2,acast)
 importFrom(stats,anova)

NEWS.md

@@ -1,5 +1,7 @@
 # Package Release News
 
+
+
 # 3.3.2
 - Debugging vignette issues on the Bioconductor build system
 

R/drugDoseResponseCurve.R

@@ -68,7 +68,7 @@
 #'
 #' @importFrom graphics plot rect points lines legend
 #' @importFrom grDevices rgb
-#' @importFrom magicaxis magaxis
+# # ' @importFrom magicaxis magaxis
 #' @importFrom CoreGx .getSupportVec
 #'
 #' @export
@@ -298,7 +298,8 @@ 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))
+  # 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))
   legends <- NULL
   legends.col <- NULL
   if (length(doses) > 1) {
@@ -333,3 +334,277 @@ function(drug,
   legend(legend.loc, legend=legends, col=legends.col, bty="n", cex=cex, pch=c(15,15))
   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))
+}