r-bioc-summarizedexperiment 1.8.0-1 / usr / lib / R / site-library / SummarizedExperiment / scripts / Find_and_update_objects / collect_rda_objects_to_update.R

This file is indexed.

/usr/lib/R/site-library/SummarizedExperiment/scripts/Find_and_update_objects/collect_rda_objects_to_update.R is in r-bioc-summarizedexperiment 1.8.0-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below. 

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
### =========================================================================
### collect_rda_objects_to_update.R
### -------------------------------------------------------------------------
###
### This script performs STEP 3 of the "Find and update objects" procedure
### described in the README file located in the same folder.
###
### Before you run this script, make sure you performed STEPS 1 & 2.
### See README file for more information.
###
### Then to run STEP 3 in "batch" mode:
###
###   cd <dir/you/want/to/search>  # RDA_OBJECTS file should be here
###   R CMD BATCH collect_rda_objects_to_update.R \
###              >collect_rda_objects_to_update.log 2>&1 &
###
### The output of STEP 3 is a file created in the current directory and named
### RDA_OBJECTS_TO_UPDATE. It is a subset of input file RDA_OBJECTS.
###

INFILE <- "RDA_OBJECTS"
OUTFILE <- "RDA_OBJECTS_TO_UPDATE"

library(BiocInstaller)
library(SummarizedExperiment)

if (FALSE) {
### Unfortunately, loading all the required packages in the main process will
### sometimes hit the maximal number of DLLs that can be loaded ("maximal
### number of DLLs reached..." infamous error).
.check_classes <- function(classes, package)
{
    suppressWarnings(suppressPackageStartupMessages(
        library(package, character.only=TRUE, quietly=TRUE)
    ))
    sapply(classes, function(class) {
           extends(class, "SummarizedExperiment") ||
           extends(class, "RangedSummarizedExperiment")
    })
}
}

### We check the classes in a subprocess to work around the "maximal number
### of DLLs reached..." infamous error.
.check_classes <- function(classes, package)
{
    classes_in1string <- paste0("\"", classes, "\"")
    classes_in1string <- paste0("c(",
                                paste(classes_in1string, collapse=", "),
                                ")")
    outfile <- file.path(tempdir(), paste0(package, "_class_summary"))
    input <- c("suppressWarnings(suppressPackageStartupMessages(",
       sprintf("    library(%s)", "SummarizedExperiment"),
               "))",
               "suppressWarnings(suppressPackageStartupMessages(",
       sprintf("    library(%s)", package),
               "))",
       sprintf("classes <- %s", classes_in1string),
               "ok <- sapply(classes, function(class) {",
               "    extends(class, \"SummarizedExperiment\") ||",
               "    extends(class, \"RangedSummarizedExperiment\")",
               "})",
               "class_summary <- data.frame(class=classes, ok=unname(ok))",
       sprintf("write.table(class_summary, file=\"%s\", sep=\"\t\")", outfile)
    )
    command <- file.path(R.home("bin"), "R")
    args <- c("--vanilla", "--slave")
    system2(command, args=args, input=input)
    class_summary <- read.table(outfile, stringsAsFactors=FALSE)
    file.remove(outfile)
    stopifnot(identical(class_summary[ , "class"], classes))  # sanity check
    setNames(class_summary[ , "ok"], classes)
}

collectRdaObjectsToUpdate <- function(rda_objects, outfile="")
{
    rda_objects2 <- unique(rda_objects[ , c("objclass", "objclass_pkg")])
    objclass2 <- rda_objects2[ , "objclass"]
    objclass_pkg2 <- rda_objects2[ , "objclass_pkg"]
    idx <- which(duplicated(objclass2))
    if (length(idx) != 0L) {
        msg <- c("the following classes are defined in more than 1 package: ",
                 paste0(unique(objclass2[idx]), collapse=", "))
        warning(msg)
    }
    pkg2class <- split(objclass2, objclass_pkg2)
    pkg2class[c(".", ".GlobalEnv")] <- NULL
    pkgs <- names(pkg2class)

    ## Install missing packages.
    installed_pkgs <- rownames(installed.packages())
    missing_pkgs <- setdiff(pkgs, installed_pkgs)
    if (length(missing_pkgs) != 0L) {
        biocLite(missing_pkgs)
        installed_pkgs <- rownames(installed.packages())
        missing_pkgs <- setdiff(pkgs, installed_pkgs)
        if (length(missing_pkgs) != 0L) {
            ## Some packages could not be installed.
            pkgs <- intersect(pkgs, installed_pkgs)
            pkg2class <- pkg2class[pkgs]
        }
    }

    ## Check classes, one package at a time.
    class2ok <- unlist(
        lapply(seq_along(pkgs),
            function(i) {
                pkg <- pkgs[[i]]
                cat("[", i , "/", length(pkgs), "] Check classes defined ",
                    "in package ", pkg, " ... ", sep="")
                ans <- .check_classes(pkg2class[[pkg]], pkg)
                cat("OK\n")
                ans
            }
        )
    )

    ## Write output to file.
    objclass <- rda_objects[ , "objclass"]
    ok <- class2ok[objclass]
    ok[is.na(ok)] <- FALSE
    rda_objects_to_update <- rda_objects[ok, , drop=FALSE]
    rda_objects_to_update <- do.call(
        paste,
        c(as.list(rda_objects_to_update), list(sep="\t"))
    )
    writeLines(rda_objects_to_update, con=outfile)
}

rda_objects <- read.table(INFILE, stringsAsFactors=FALSE)
colnames(rda_objects) <- c("rda_file", "objname", "objclass", "objclass_pkg")
collectRdaObjectsToUpdate(rda_objects, outfile=OUTFILE)

APT Browse - Built by Thomas Orozco.