Fix warnings and errors

.travis.yml

@@ -26,3 +26,9 @@ notifications:
   email:
     on_success: change
     on_failure: change
+
+r_package:
+  - covr
+
+after_success: 
+  - Rscript -e 'library(covr); codecov()'

COMPASS.Rproj

@@ -16,6 +16,4 @@ AutoAppendNewline: Yes
 StripTrailingWhitespace: Yes
 
 BuildType: Package
-PackageUseDevtools: Yes
 PackageInstallArgs: --no-multiarch --with-keep.source
-PackageRoxygenize: rd,collate,namespace

DESCRIPTION

@@ -29,7 +29,6 @@ Imports:
     methods,
     Rcpp,
     data.table,
-    methods,
     RColorBrewer,
     scales,
     grid,

R/COMPASS.R

@@ -416,7 +416,7 @@ COMPASS <- function(data, treatment, control, subset=NULL,
             n_u <- reduced$n_u
         }
     }else if(class(dropDegreeOne)=="character"){
-        .drop_degree_one <- function(categories=NULL,n_s=NULL,n_u=NULL,marker=dropDegreeOne){
+        .drop_degree_one_ <- function(categories=NULL,n_s=NULL,n_u=NULL,marker=dropDegreeOne){
             to_drop <- categories[,"Counts"]==1
             if(!all(marker%in%colnames(categories))){
                 stop(paste0("Invalid marker name(s): ",paste(marker[!marker%in%colnames(categories)],collapse=",")))
@@ -434,7 +434,7 @@ COMPASS <- function(data, treatment, control, subset=NULL,
             categories_new <- categories_new[!to_drop,,drop=FALSE]
             return(list(categories=categories_new,n_s=n_s_new,n_u=n_u_new))
         }
-        reduced <- .drop_degree_one(categories=categories,n_s=n_s,n_u=n_u,marker=dropDegreeOne)
+        reduced <- .drop_degree_one_(categories=categories,n_s=n_s,n_u=n_u,marker=dropDegreeOne)
         categories <- reduced$categories
         n_s <- reduced$n_s
         n_u <- reduced$n_u

R/CellCounts.R

@@ -1,3 +1,6 @@
+globalVariables(c("name","trtLabels","show_colnames","runApp"))
+
+
 ##' Compute Number of Cells Positive for Certain Cytokine Combinations
 ##'
 ##' Compute the number of cells expressing a particular

R/GatingSetToCOMPASS.R

@@ -90,7 +90,7 @@ COMPASSContainerFromGatingSet<-function(gs = NULL, node = NULL, filter.fun = NUL
 
     #stats <- getPopStats(gs, statistic = "count")
 
-    pd <- pData(gs)
+    pd <- flowWorkspace::pData(gs)
     #now we force 'name' column to be the same as rownames
     sample_id <- "name"
     pd[["name"]] <- rownames(pd)
@@ -102,7 +102,7 @@ COMPASSContainerFromGatingSet<-function(gs = NULL, node = NULL, filter.fun = NUL
                                                                             colnames(pd))]))
       stop("Quitting")
     }
-    
+
     # Get the children of that parent and filter out boolean gates Test if
     # children exist, and test if non-empty set returned.
     message("Fetching child nodes")
@@ -137,19 +137,19 @@ COMPASSContainerFromGatingSet<-function(gs = NULL, node = NULL, filter.fun = NUL
           dat <- flowWorkspace::getData(x, use.exprs=FALSE)
           lapply( objects(dat@frames), function(obj) {
             fr <- get(obj, envir=dat@frames)
-            return(na.omit( parameters(fr)@data$desc ))
+            return(na.omit( flowCore::parameters(fr)@data$desc ))
           })
         }) )
       } else if (inherits(xx, "GatingSet")) {
         dat <- flowWorkspace::getData(xx, use.exprs=FALSE)
         mlist <- lapply( objects(dat@frames), function(obj) {
           fr <- get(obj, envir=dat@frames)
-          return(na.omit( parameters(fr)@data$desc ))
+          return(na.omit( flowCore::parameters(fr)@data$desc ))
         })
       } else {
         stop("Expected object of type 'GatingSetList' or 'GatingSet'")
       }
-      mlist <- flowWorkspace::lapply(xx, function(x) na.omit(parameters(getData(x,
+      mlist <- flowWorkspace::lapply(xx, function(x) na.omit(flowCore::parameters(flowWorkspace::getData(x,
                                                                                 use.exprs = FALSE))@data$desc))
       common <- Reduce(intersect, mlist)
       unyn <- Reduce(union, mlist)
@@ -175,7 +175,7 @@ COMPASSContainerFromGatingSet<-function(gs = NULL, node = NULL, filter.fun = NUL
 
     .checkMarkerConsistency(gs)
     if (is.null(mp)) {
-      params <- parameters(flowWorkspace::getData(gs[[1]], use.exprs = FALSE))@data
+      params <- flowCore::parameters(flowWorkspace::getData(gs[[1]], use.exprs = FALSE))@data
       params <- data.table(params[, c("name", "desc")])
       if(swap){
         setnames(params,c("name","desc"),c("desc","name"))
@@ -267,14 +267,14 @@ COMPASSContainerFromGatingSet<-function(gs = NULL, node = NULL, filter.fun = NUL
     # extract the single cell values
     #exprs can now be a vector of characters
     expr<-do.call(c,strsplit(as.character(expr),"\\|"))
-    
+
     ##validity check on the parent children relationship
     children.ids <- sapply(full.child.nodes, flowWorkspace:::.getNodeInd, obj = gs[[1]], USE.NAMES = FALSE)
     map.ids <- sapply(expr, flowWorkspace:::.getNodeInd, obj = gs[[1]], USE.NAMES = FALSE)
     ind <- !map.ids %in% children.ids
     if(any(ind))
       stop(paste(expr[ind], collapse = "|"), " are not the children node of ", unique.node)
-    sc_data <- try(getSingleCellExpression( x=gs, nodes = expr, map = mp,swap=swap))
+    sc_data <- try(flowWorkspace::getSingleCellExpression( x=gs, nodes = expr, map = mp,swap=swap))
     if(inherits(sc_data,"try-error")){
       message("getData failed. Perhaps the marker list is not unique in the flowFrame.")
       message("All markers and channels:")

R/GetThresholdedIntensities.R

@@ -99,7 +99,7 @@ GetThresholdedIntensities <- function(gs, node, map) {
     ## Try to guess whether we should be pulling names from the 'desc'
     ## column or the 'name' column of the flowSets
     ff <- flowWorkspace::getData(gs[[1]], use.exprs=FALSE)
-    params <- parameters(ff)@data
+    params <- flowCore::parameters(ff)@data
 
     ## First, check for a perfect match using a basic regex
     .check_match <- function(x, vec) {
@@ -112,7 +112,7 @@ GetThresholdedIntensities <- function(gs, node, map) {
     column_to_use <- NULL ## are we going to use 'desc' or 'name'?
     indices <- NULL ## what indices are we using to pull from the flowFrame?
 
-    if (!all(params$name == colnames( exprs(ff) ))) {
+    if (!all(params$name == colnames( flowCore::exprs(ff) ))) {
       stop("Internal Error: expected 'params$desc' and 'colnames( exprs(ff) )' to ",
         "be identical but they are not!", call.=FALSE)
     }
@@ -140,7 +140,7 @@ GetThresholdedIntensities <- function(gs, node, map) {
     ## Extract the intensities
     message("Extracting cell intensities and thresholding...")
     intensities <- lapply(gslist, function(x) {
-      exprs <- exprs( getData(x, path) )[, expr_nms, drop=FALSE]
+      exprs <- flowCore::exprs( flowWorkspace::getData(x, path) )[, expr_nms, drop=FALSE]
       for (i in seq_along(node_names)) {
         cNode <- node_names[i]
         cChannel <- channel_names[i]

R/RcppExports.R

@@ -2,10 +2,10 @@
 # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
 
 CellCounts_character <- function(data, combinations) {
-    .Call(`_COMPASS_CellCounts_character`, data, combinations)
+    .Call(`C_COMPASS_CellCounts_character`, data, combinations)
 }
 
 .CellCounts <- function(x, combos) {
-    .Call(`_COMPASS_CellCounts`, x, combos)
+    .Call(`C_COMPASS_CellCounts`, x, combos)
 }
 

R/pheatmap.R

@@ -953,7 +953,8 @@ kmeans_pheatmap = function(mat, k = min(nrow(mat), 150), sd_limit = NA, ...){
 #' #Specify row annotations
 #' row_ann <- data.frame(foo=gl(2,nrow(test)/2),`Bar`=relevel(gl(2,nrow(test)/2),"2"))
 #' rownames(row_ann)<-rownames(test)
-#' pheatmap(test, annotation = annotation, annotation_legend = FALSE, drop_levels = FALSE,row_annotation = row_ann)
+#' pheatmap(test, annotation = annotation, annotation_legend = FALSE,
+#'     drop_levels = FALSE,row_annotation = row_ann)
 #'
 #' #Using cytokine annotations
 #' M<-matrix(rnorm(8*20),ncol=8)
@@ -964,7 +965,9 @@ kmeans_pheatmap = function(mat, k = min(nrow(mat), 150), sd_limit = NA, ...){
 #' rownames(M)<-1:nrow(M)
 #' colnames(M)<-rownames(eg)
 #' cytokine_annotation=eg
-#' pheatmap(M,annotation=annotation,row_annotation=row_annotation,annotation_legend=TRUE,row_annotation_legend=TRUE,cluster_rows=FALSE,cytokine_annotation=cytokine_annotation,cluster_cols=FALSE)
+#' pheatmap(M,annotation=annotation,row_annotation=row_annotation,
+#'      annotation_legend=TRUE,row_annotation_legend=TRUE,
+#'     cluster_rows=FALSE,cytokine_annotation=cytokine_annotation,cluster_cols=FALSE)
 #'
 #' # Specifying clustering from distance matrix
 #' drows = dist(test, method = "minkowski")

R/plotMeanGammaMulti.R

@@ -225,13 +225,15 @@ mergeMatricesForPlotCOMPASSResultStack <- function(x,
 ##' with e.g. \code{grid::grid.draw()}.
 ##' @export
 ##' @examples
+##' \dontrun{
 ##' # allCompassResults is a list of 4 COMPASSResults
 ##' names(allCompassResults) <- c("Antigen 85A", "CFP-10", "CMV", "ESAT-6")
 ##' plotCOMPASSResultStack(allCompassResults,
 ##'     row_annotation = c("Antigen", "PATIENT ID", "Time"),
 ##'     variable = "Antigen", show_rownames = FALSE,
 ##'     main = "Heatmap of Mean Probability of Response to Antigens, CD8+",
 ##'     fontsize = 14, fontsize_row = 13, fontsize_col = 11)
+##'   }
 plotCOMPASSResultStack <- function(x,
                                    threshold=0.01,
                                    minimum_dof=1,

R/utils.R

@@ -157,7 +157,7 @@ select_compass_pops = function(cellpops,markers){
 #' popnames = popnames[select_compass_pops(popnames,LETTERS[1:4])]
 #' #Translate
 #' translate_marker_names(popnames)
-translate_marker_names = function(x){
-  gsub(",Count$","",gsub("&$","",gsub("(\\w*)\\+","\\1&",gsub("(\\w*)-","!\\1&",x))))
+translate_marker_names = function(cellpops){
+  gsub(",Count$","",gsub("&$","",gsub("(\\w*)\\+","\\1&",gsub("(\\w*)-","!\\1&",cellpops))))
 }