R/sgnPackages.r

   1 # R packages required on SGN websites
   2
   3 #removes older ones of duplicate packages
   4 #installs new ones from CRAN, bioconductor, github
   5 #in ~/cxgn/R_libs
   6
   7 #Leaves behind deps installed in site libraries ("/usr/local/lib/R/site-library:/usr/lib/R/site-library:/usr/lib/R/library")
   8 #To avoid future version conflicts between deps installed in these libraries and 'cxgn/sgn/R_libs', you would be better off
   9 #removing them manually.
  10
  11
  12 #Set the env variable R_LIBS_USER in /etc/R/Renviron to '~/cxgn/R_libs' in your local system or to '/usr/local/share/website/R_libs' in the production servers.
  13 #This will ensure deps you manually install in R will be in the same place as sgn R libraries
  14 #and avoid installation of the same R packages in multiple places.
  15 #It will also add packages in the \"~/cxgn/R_libs\" to the search path";
  16
  17 rLibsUser <- unlist(strsplit(Sys.getenv("R_LIBS_USER"), .Platform$path.sep))
  18 rLibsSite <- unlist(strsplit(Sys.getenv("R_LIBS_SITE"), .Platform$path.sep))
  19 rLibsSgn  <- "~/cxgn/R_libs"
  20 cranSite  <-  'http://mirror.las.iastate.edu/CRAN/'
  21 cranFile  <- "~/cxgn/sgn/R_files/cran"
  22 gitFile   <- "~/cxgn/sgn/R_files/github"
  23 bioCFile  <- "~/cxgn/sgn/R_files/bioconductor"
  24
  25 preRLibsSgn <- grep(rLibsSgn, rLibsUser, perl=TRUE, value=TRUE)
  26
  27 if (!is.null(preRLibsSgn) || !file.exists(preRLibsSgn)) {
  28   dir.create(rLibsSgn, recursive = TRUE, showWarnings = TRUE)
  29 }
  30
  31 if(!dir.exists(rLibsSgn))
  32 {
  33     stop("SGN R Libs dir ", rLibsSgn, ' Does not exist and failed to create it.')
  34 } else {
  35   Sys.setenv(R_LIBS_USER=rLibsSgn)
  36 }
  37
  38 .libPaths(c(rLibsSgn, .libPaths()))
  39
  40 if (!require(stringr, lib.loc=rLibsSgn, quietly=TRUE, warn.conflicts=FALSE)) {
  41   install.packages('stringr', repos=cranSite)
  42   library(stringr)
  43 }
  44
  45 if (!require(dplyr, lib.loc=rLibsSgn, quietly=TRUE, warn.conflicts=FALSE)) {
  46   install.packages('dplyr', repos=cranSite)
  47   library(dplyr)
  48 }
  49
  50 if (!require(devtools, lib.loc=rLibsSgn, quietly=TRUE, warn.conflicts=FALSE)) {
  51   install.packages('devtools', repos=cranSite)
  52   library(devtools)
  53 }
  54
  55
  56 installedPackages <- function (..., lib.loc=NULL) {
  57
  58   pks <- installed.packages(..., lib.loc=lib.loc)
  59   pks <- pks[, c('Package', 'LibPath', 'Version')]
  60   pks <- data.frame(pks, stringsAsFactors=FALSE)
  61
  62 }
  63
  64
  65 duplicatedPackagesDf <- function(packagesDf) {
  66
  67   dupPackages <- packagesDf %>%
  68     group_by(Package) %>%
  69       filter(n()>1) %>%
  70         arrange(Package) %>%
  71           data.frame()
  72
  73   if (is.data.frame(dupPackages) == FALSE) {
  74     dupPackages <- NULL
  75   }
  76 }
  77
  78
  79 dupPackNames <- function(dupPackDf) {
  80
  81   dupsNames <- c()
  82   if(!is.null(dupPackDf)) {
  83   if (is.data.frame(dupPackDf)) {
  84     dupsNames <- dupPackDf %>%
  85       select(Package) %>%
  86         distinct() %>%
  87           data.frame()
  88
  89     if (nrow(dupsNames) == 0) {
  90       dupsNames <- NULL
  91     } else {
  92       dupsNames <- dupsNames$Package
  93     }
  94   }
  95 }
  96   return(dupsNames)
  97 }
  98
  99
 100 removeOlderPackages <- function (dupPackages) {
 101
 102   dupNames <- dupPackNames(dupPackages)
 103
 104   for (dN in dupNames) {
 105     dupsDf <- dupPackages %>%
 106       filter(Package == dN) %>%
 107         data.frame
 108
 109     dupCnt <- nrow(dupsDf)
 110
 111     while (dupCnt > 1 ) {
 112       message('package ', dN, ' ', dupCnt, ' times duplicated')
 113       v <- compareVersion(dupsDf[1, 'Version'], dupsDf[2, 'Version'])
 114
 115       if (v == 0) {
 116         lb <- dupsDf$LibPath[1]
 117         message( 'removing double copy ', dN, ' from ', lb)
 118         remove.packages(dN, lib=lb)
 119
 120         dupsDf <- dupsDf %>%
 121           filter(LibPath != lb) %>%
 122             data.frame
 123
 124       } else if (v == 1)  {
 125         lb <- dupsDf[2, 'LibPath']
 126         message( 'removing older copy ', dN, ' from ', lb)
 127         remove.packages(dN, lib=lb)
 128
 129         dupsDf <- dupsDf %>%
 130           filter(LibPath != lb) %>%
 131             data.frame
 132
 133       } else if (v == -1) {
 134         lb <- dupsDf[1, 'LibPath']
 135         message( 'removing older copy ', dN, ' from ', lb)
 136         remove.packages(dN, lib=lb)
 137
 138         dupsDf <- dupsDf %>%
 139           filter(LibPath != lb) %>%
 140             data.frame
 141       }
 142
 143       dupCnt <- nrow(dupsDf)
 144     }
 145   }
 146 }
 147
 148
 149 filterFilePackages <- function (depsF) {
 150
 151   fP <- read.dcf(depsF, fields="Depends")
 152   fP <- unlist(strsplit(fP, ','))
 153   fP <- trimws(fP, 'both')
 154   fP <- gsub("\\s*\\(.*\\)", '', fP, perl=TRUE)
 155   fP <- fP[fP != 'R']
 156
 157 }
 158
 159 insPacks <- installedPackages(lib.loc=rLibsSgn)
 160 dupPackages <- duplicatedPackagesDf(insPacks)
 161 removeOlderPackages(dupPackages)
 162
 163 cranPacks       <- filterFilePackages(cranFile)
 164 biocPacks       <- filterFilePackages(bioCFile)
 165 githubPackPaths <- filterFilePackages(gitFile)
 166 githubPacks     <- basename(githubPackPaths)
 167
 168 allReqPacks <-c(cranPacks, biocPacks, githubPacks)
 169
 170 insPacksUni <- unique(insPacks$Package)
 171
 172 newCran <- cranPacks[!cranPacks %in% insPacksUni]
 173 newGit  <- githubPacks[!githubPacks %in% insPacksUni]
 174 newBioc <- biocPacks[!biocPacks %in% insPacksUni]
 175
 176 #stop('quit before install...')
 177
 178 if (length(newCran) > 0) {
 179   install.packages(newCran,
 180                    repos=cranSite,
 181                    quiet=TRUE,
 182                    verbose=FALSE)
 183 } else {
 184   message('No new cran packages to install.')
 185 }
 186
 187 newGitPaths <- c()
 188 if (!is.null(newGit)) {
 189
 190   for (ng in newGit) {
 191     ngp <- grep(ng, githubPackPaths, value=TRUE)
 192     ifelse(is.null(newGitPaths), newGitPaths <- ngp,  newGitPaths <- c(newGitPaths, ngp))
 193   }
 194 }
 195
 196 if (length(newGitPaths) > 0) {
 197     withr::with_libpaths(new=rLibsSgn,
 198                          install_github(newGitPaths,
 199                                         force=TRUE,
 200                                         quiet=TRUE,
 201                                         verbose=FALSE))
 202 } else {
 203   message('No new github packages to install.')
 204 }
 205
 206
 207 if (length(newBioc) > 0 ) {
 208     source('http://bioconductor.org/biocLite.R')
 209     biocLite(newBioc,
 210              suppressUpdates=TRUE,
 211              suppressAutoUpdate=TRUE,
 212              ask=FALSE,
 213              quiet=TRUE,
 214              verbose=FALSE,
 215              siteRepos=cranSite)
 216 } else {
 217   message('No new bioconductor packages to install.')
 218 }