Making ribiosPlot for CRAN submission

.gitignore

@@ -6,3 +6,5 @@ inst/doc
 .Rhistory
 .RDatat
 *.swp
+*.Rcheck
+*.tar.gz

DESCRIPTION

@@ -1,18 +1,15 @@
 Package: ribiosPlot
 Type: Package
-Title: Plotting Module of Ribios for Visualization
+Title: Plotting Module of the 'ribios' Software Suite
 Version: 1.3.0
 Date: 2026-01-24
 Authors@R:
   c(person(given = "Jitao David",
            family = "Zhang",
            role = c("aut", "cre", "ctb"),
            email = "jitao_david.zhang@roche.com",
-           comment = c(ORCID="0000-0002-3085-0909")),
-    person("F.Hoffmann-La Roche AG", role="cph"))
-Description: Provides data structures and functions for data transformation
-    and visualization in computational biology. Includes heatmaps, color
-    schemes, PCA plots, and various plotting utilities for drug discovery.
+           comment = c(ORCID="0000-0002-3085-0909")))
+Description: Provides data structures and functions for data transformation and visualization in computational biology in drug discovery. Includes heatmaps, color schemes, PCA plots, and various plotting utilities.
 Depends:
     R (>= 3.4.0)
 Imports:
@@ -21,7 +18,6 @@ Imports:
     RColorBrewer,
     grid,
     gridExtra,
-    utils,
     graphics,
     ribiosUtils,
     stats,
@@ -67,3 +63,4 @@ LazyLoad: yes
 Encoding: UTF-8
 RoxygenNote: 7.3.3
 VignetteBuilder: knitr
+Additional_repositories: https://bedapub.r-universe.dev

NAMESPACE

@@ -127,12 +127,9 @@ importFrom(graphics,abline)
 importFrom(graphics,legend)
 importFrom(graphics,panel.smooth)
 importFrom(grid,gpar)
-importFrom(grid,grid.layout)
+importFrom(grid,grid.newpage)
 importFrom(grid,grid.text)
-importFrom(grid,plotViewport)
-importFrom(grid,pushViewport)
 importFrom(grid,unit)
-importFrom(grid,viewport)
 importFrom(lattice,panel.xyplot)
 importFrom(ribiosUtils,assertFile)
 importFrom(ribiosUtils,basefilename)
@@ -145,4 +142,3 @@ importFrom(ribiosUtils,isOdd)
 importFrom(ribiosUtils,mmatch)
 importFrom(stats,cor)
 importFrom(stats,lm)
-importFrom(utils,assignInNamespace)

R/PCAScoreMatrix.R

@@ -95,7 +95,7 @@ as.data.frame.PCAScoreMatrix <- function(x,
 #' 
 #' @param x A \code{PCAScoreMatrix} S3-object
 #' @param ... Ignored
-#' @return NULL, side effect is used
+#' @return The input \code{x}, invisibly.
 #' @examples
 #' 
 #' myPCmat <- PCAScoreMatrix(matrix(rnorm(15),ncol=3), c(0.25, 0.15, 0.1))
@@ -112,5 +112,6 @@ print.PCAScoreMatrix <- function(x, ...) {
   cat("Options\n")
   cat("-- Use 'as.matrix' to turn this object into a simple matrix\n")
   cat("-- Use 'expVar' to extract explained variances\n")
-  cat("-- Use 'expVarLabel' to generate labels of explained variances")
+  cat("-- Use 'expVarLabel' to generate labels of explained variances\n")
+  invisible(x)
 }

R/cascadePlot.R

@@ -120,6 +120,7 @@ nonNegCascadeOrder <- function(matrix) {
 #'             zlim=c(-4,4), col="royalbluered",
 #'             main="Cascade order")
 #' 
+#' @return An integer vector of row indices in cascade order.
 #' @export cascadeOrder
 cascadeOrder <- function(matrix, dichotomy=c('maxabs', 'mean', 'median')) {
     dichotomy <- match.arg(dichotomy)

R/colors.R

@@ -8,7 +8,7 @@
 #' 
 #' The values for \sQuote{low, mid, high} can be given as color names
 #' (\sQuote{red}), plot color index (\code{2}=red), and HTML-style RGB,
-#' (\dQuote{\#FF0000}=red).
+#' (\dQuote{#FF0000}=red).
 #' 
 #' If \sQuote{mid} is supplied, then the returned color panel will consist of
 #' \sQuote{n - floor(n/2)} HTML-style RGB elements which vary smoothly between
@@ -136,14 +136,13 @@ brewer.pal.factorLevels <- function(factor, name="Greys") {
 #' @author Jitao David Zhang <jitao_david.zhang@@roche.com>
 #' @examples
 #' 
-#' \dontrun{
+#' \donttest{
 #' myFac <- factor(c("HSV", "BVB", "FCB", "HSV", "BVB", "HSV"))
 #' brewer.pal.factor(myFac, name="Set1")
-#' brewer.pal.factorLevels(myFac, name="Set1")
-#' 
+#'
 #' myLongFac <- factor(paste("Sample", 1:20))
 #' brewer.pal.factor(myLongFac, name="Set1")
-#' 
+#'
 #' myShortFac <- factor(paste("Sample", 1:2))
 #' brewer.pal.factor(myShortFac, name="Set1")
 #' }
@@ -387,21 +386,21 @@ display.threecolor.panels <- function (nc=20) {
 #' 
 #' midCol("black", "red")
 #' midCol(c("black", "red"))
-#' \dontrun{
+#' \donttest{
 #' set.seed(1778)
 #' nCol <- 20
 #' candCol <- grep("gr[a|e]y", colors(), value=TRUE, invert=TRUE)
 #' firstCols <- sample(candCol, nCol)
 #' secondCols <- rev(sample(candCol, nCol))
-#' midCols <- sapply(seq(along=firstCols), function(i) 
+#' midCols <- sapply(seq(along=firstCols), function(i)
 #'   midCol(firstCols[i], secondCols[i]))
 #' plot.new()
 #' plot.window(xaxt="n", yaxt="n", xlim=c(0, nCol),
 #'      ylim=c(0.5, 4), bty="n")
 #' title("Example of midCol")
 #' segments(x0=1:nCol, y0=0, x1=1:nCol, y1=4, col="lightgray")
 #' points(x=rep(1:nCol, each=3),
-#'      y=rep(1:3, nCol), 
+#'      y=rep(1:3, nCol),
 #'      pch=21, cex=1.75,
 #'      bg=as.vector(rbind(firstCols, midCols, secondCols)))
 #' text(0, c(1.5, 2.5, 3.5), c("Second", "Midpoint", "First"),

R/compactTrellis.R

@@ -28,19 +28,23 @@ compactTrellis <- function() {
 }
 
 #' Set compact trellis as default
-#' 
-#' The function sets compact trellis options as default
-#' 
-#' 
-#' @return as \code{lattice.options}. The side-effect is used.
+#'
+#' The function sets compact trellis options as default.
+#' The previous \code{lattice.options} are saved and restored
+#' via \code{on.exit} when the calling function exits.
+#'
+#' @return Invisibly, the previous value of the \code{default.theme}
+#'   lattice option, so it can be restored manually if needed.
 #' @examples
-#' 
-#' \dontrun{
-#' setCompactTrellis()
+#'
+#' \donttest{
+#' old <- setCompactTrellis()
 #' }
-#' 
+#'
 #' @export setCompactTrellis
 setCompactTrellis <- function() {
-  lattice::lattice.options("default.theme"=compactTrellis())
+  old <- lattice::lattice.options("default.theme")
+  lattice::lattice.options("default.theme" = compactTrellis())
+  invisible(old)
 }
 

R/expVar.R

@@ -62,6 +62,8 @@ expVar.PCAScoreMatrix <- function(x, choices) {
 #' @param x \code{prcomp} or \code{PCAScoreMatrix} Object
 #' @param choices Integer indices of which PCs to be returned
 #' @param compact Logical, whether a compact format is returned, see example
+#' @return A character vector of labels describing the explained variance
+#'   of each principal component.
 #' @export expVarLabel
 expVarLabel <- function(x, choices, compact) UseMethod("expVarLabel")
 
@@ -75,6 +77,8 @@ expVarLabel <- function(x, choices, compact) UseMethod("expVarLabel")
 #' \code{NULL} or \code{NA} or missing, all elements are returned.
 #' @param compact Logical, either a \code{compact} label is returned, see
 #' examples.
+#' @return A character vector of labels in the form
+#'   \code{"Principal component N (X\% variance explained)"}.
 #' @export
 getExpVarLabel <- function(ev, choices, compact=FALSE) {
   if(missing(choices) || is.null(choices) || (length(choices)==1 && is.na(choices)))

R/fcol.R

@@ -29,6 +29,7 @@ fcbase <- function(fcol) {
 #' Print a fcol object
 #' @param x A fcol object, likely constructed by \code{\link{fcol}}
 #' @param ... Not used now
+#' @return The input \code{x}, invisibly.
 #' @examples
 #' fc <- fcol(c("lightblue", "orange", "lightblue"), base=c("orange", "lightblue"))
 #' fc
@@ -41,6 +42,7 @@ print.fcol <- function(x, ...) {
       "Colors: (", length(acol), "):", ribiosUtils::chosenFew(acol),"\n",
       "Base colors (", length(bcol), "):", ribiosUtils::chosenFew(fcbase(x)), "\n",
       sep="")
+  invisible(x)
 }
 
 #' Replace base colors of a fcol object with a different value

R/hist.R

@@ -60,11 +60,8 @@ qHist <- function(x,quantiles=0.25, breaks=100,
 #' @seealso This function is directly used by \code{qHist}
 #' @examples
 #' 
-#' \dontrun{
 #' testVal <- rnorm(1000)
-#' qBreaks(testVal, quantiles=c(0.25, 0.75), breaks=100) ## should be about
-#' 400
-#' }
+#' qBreaks(testVal, quantiles=c(0.25, 0.75), breaks=100)
 #' 
 #' @export
 qBreaks <- function(x,quantiles=c(0,0.99), breaks=100) {
@@ -143,6 +140,8 @@ xclipHist <- function(x, xclip=c(0.01, 0.99), breaks=100,
 #' testMat <- matrix(rnorm(1000), nrow=100)
 #' histMat(testMat)
 #' 
+#' @return Invisibly, a list as returned by \code{\link{hist}}, with
+#'   additional elements \code{xlim} and \code{linesOpt}.
 #' @export histMat
 histMat <- function(mat,
                     linesOpt=list(lwd=NULL, col=NULL,lty=NULL, type=NULL, pch=NULL),

R/pairs.R

@@ -8,7 +8,9 @@
 #' @param ... Passed to \code{cor}.
 #'
 #' This function can be used with \code{pairs} to display correlations.
-#' @seealso \code{\link[graphics]{pairs}}. 
+#' @return No return value, called for side effects as a panel function
+#'   in \code{\link[graphics]{pairs}}.
+#' @seealso \code{\link[graphics]{pairs}}.
 #' @importFrom stats cor
 #' @export
 panel.cor <- function(x, y, digits = 2, prefix = "", cex.cor, ...) {
@@ -37,11 +39,13 @@ panel.cor <- function(x, y, digits = 2, prefix = "", cex.cor, ...) {
 #'
 #' This function can be used with \code{pairs} to display correlations.
 #'
-#' @seealso \code{\link[graphics]{pairs}}. 
+#' @return No return value, called for side effects as a panel function
+#'   in \code{\link[graphics]{pairs}}.
+#' @seealso \code{\link[graphics]{pairs}}.
 #' @importFrom stats cor lm
 #' @importFrom graphics panel.smooth legend abline
 #' @export
-panel.lmSmooth <- function(x,y, col = par("col"), bg = NA, pch = par("pch"), 
+panel.lmSmooth <- function(x,y, col = par("col"), bg = NA, pch = par("pch"),
                       cex = 0.8, method="spearman", use="complete", ...) {
 
   corr <- cor(x,y, method=method, use=use)

R/pcaPlots.R

@@ -22,6 +22,7 @@
 #' testPCAscores.withReverse <- pcaScores(testPCA, reverse=c(TRUE, FALSE))
 #' colMeans(as.matrix(testPCAscores.withReverse)[c(1,3,5),])
 #' 
+#' @return A \code{\link{PCAScoreMatrix}} object containing the PCA scores.
 #' @export pcaScores
 pcaScores <- function(x, choices, offset, reverse=c(FALSE, FALSE)) {
   stopifnot(all(is.logical(reverse)) & length(reverse)<=2)
@@ -137,6 +138,7 @@ pcaRotation <- function(x, choices, offset, reverse=c(FALSE, FALSE)) {
 #' @param x A prcomp object
 #' @param choices Integer index, choices to plot
 #' @param ... Other parameters
+#' @return Depends on the method; see individual method documentation.
 #' @export plotPCA
 plotPCA <- function(x, choices, ...) UseMethod("plotPCA")
 
@@ -407,6 +409,7 @@ plotPCA.prcomp <- function(x,
 #' @param title Character string
 #' @param subtitle Character string
 #' @param ... Passed to \code{\link{plot}}
+#' @return No return value, called for side effects (plotting).
 #' @export
 plotPCAloading <- function(loadings, x=1L, y=2L, circle=FALSE, title="", subtitle="",...) {
   plot(loadings[,x],loadings[,y],
@@ -427,11 +430,14 @@ plotPCAloading <- function(loadings, x=1L, y=2L, circle=FALSE, title="", subtitl
 }
 
 plotPCAscores <- function(scores, class, legendX, legendY, title="",...) {
+  oldpar <- par(no.readonly = TRUE)
+  on.exit(par(oldpar))
+
   colbase <- brewer.pal.factorLevels(class, name="Set1")
   cols <- colbase[class]
   symbol <- rep(c(15:18,1:4),5L)
   vsym <- symbol[as.numeric(as.factor(class))]
-  
+
   par(mfrow=c(1,2),oma=c(0,0,2,4))
   plot(scores$x[,1],scores$x[,2],
        pch=vsym,
@@ -442,7 +448,7 @@ plotPCAscores <- function(scores, class, legendX, legendY, title="",...) {
        main="Front View",...)
   abline(h=0,v=0,lty=2)
   grid()
-  
+
   par(mfrow=c(1,2),oma=c(0,4,2,0))
   plot(scores$x[,3],scores$x[,2],
        pch=vsym,
@@ -453,8 +459,8 @@ plotPCAscores <- function(scores, class, legendX, legendY, title="",...) {
        main="Side View",...)
   abline(h=0,v=0,lty=2)
   grid()
-  
-  par(xpd=NA)   # This allows the legend to be printed outside the plot region
+
+  par(xpd=NA)
   legend(legendX,legendY,
          levels(class),
          pch=symbol[levels(class)],
@@ -463,7 +469,6 @@ plotPCAscores <- function(scores, class, legendX, legendY, title="",...) {
          cex=1, pt.cex=2,
          title="")
   title(title,outer=TRUE)
-  par(xpd=F)
 }
 
 
@@ -486,6 +491,8 @@ plotPCAscores <- function(scores, class, legendX, legendY, title="",...) {
 #' lfcMat <- matrix(rnorm(9), nrow=3)
 #' pcaScoresFromLogFC(lfcMat)
 #' 
+#' @return A \code{\link{PCAScoreMatrix}} object containing the PCA scores
+#'   derived from the log fold-change matrix.
 #' @export
 pcaScoresFromLogFC <- function(lfcMat,
                                reference=0,