Merge branch 'main' of https://github.com/OHDSI/Hades

.Rbuildignore

@@ -11,3 +11,4 @@ Rmd
 compare_versions
 _pkgdown.yml
 .github/
+hadesWideReleases

extras/Releasing/.Rprofile

@@ -0,0 +1 @@
+source("renv/activate.R")

extras/Releasing/CreateRenvLockFile.R

@@ -0,0 +1,29 @@
+# Here we create an empty renv library, and install all of HADES. We  then 
+# create an renv.lock file to capture all current versions.
+
+# Make sure to delete renv.lock, .Rprofile, and the renv folder first
+
+# Create an empty renv library -------------------------------------------------
+renv::activate()
+
+# Install HADES (from scratch --------------------------------------------------
+install.packages("remotes")
+options(install.packages.compile.from.source = "never")
+remotes::install_github("ohdsi/Hades")
+
+# Create renv lock file --------------------------------------------------------
+remotes::install_github("ohdsi/OhdsiRTools")
+
+packagesUtils <- c("keyring")
+packagesForPlp <- c("lightgbm", "survminer", "parallel")
+install.packages(c(packagesForPlp, packagesUtils))
+
+OhdsiRTools::createRenvLockFile(
+  rootPackage = "Hades",
+  mode = "description",
+  includeRootPackage = TRUE,
+  additionalRequiredPackages = c(packagesForPlp, packagesUtils)
+)
+# Manually fix remoteRef and remoteUserName  of HADES entry
+
+renv::init()

extras/Releasing/PackageCheckFunctions.R

@@ -0,0 +1,85 @@
+# Returns the list of reverse dependencies, and installs all dependencies of those packages
+prepareForPackageCheck <- function() {
+  packageListUrl <- "https://raw.githubusercontent.com/OHDSI/Hades/main/extras/packages.csv"
+  gitHubOrganization <- "ohdsi"
+  hadesPackageList <- read.table(packageListUrl, sep = ",", header = TRUE) 
+
+  dependencies <- lapply(hadesPackageList$name, getPackageDependenciesFromGitHub)
+  dependencies <- do.call(rbind, dependencies)
+  hadesDependencies <- dependencies[dependencies$dependency %in% hadesPackageList$name & 
+                                      dependencies$type != "Suggests", ]
+
+
+  # Includes suggests of packages to check, but not suggests of deeper dependencies:
+  packagesToInstall <- unique(dependencies$dependency)
+  packagesToInstall <- c(packagesToInstall, "formatR") # Required for some vignettes
+  # Don't install packages that are already installed:
+  packagesToInstall <- packagesToInstall[!packagesToInstall %in% rownames(installed.packages())]
+
+  if (length(packagesToInstall) > 0) {
+    remotes::install_cran(packagesToInstall)
+  }
+  return(hadesPackageList)
+}
+
+#   for (package in reverseDependencies) {
+#     if (hadesPackageList$inCran[hadesPackageList$name == package]) {
+#       source <- "CRAN"
+#     } else {
+#       source <- "GitHub"
+#     }
+#     checkPackage(package, source)
+#   }
+# }
+
+checkPackage <- function(package, inCran) {
+  writeLines(sprintf("*** Checking package '%s' ***", package))
+  gitHubOrganization <- "ohdsi"
+  if (inCran) {
+    sourcePackage <- remotes::download_version(package, type = "source")
+    on.exit(unlink(sourcePackage))
+  } else {
+    sourcePackage <- remotes::remote_download(remotes::github_remote(sprintf("%s/%s", gitHubOrganization, package)))
+    on.exit(unlink(sourcePackage))
+  } 
+  sourceFolder <- tempfile(pattern = package)
+  dir.create(sourceFolder)
+  on.exit(unlink(sourceFolder, recursive = TRUE), add = TRUE)
+  untar(sourcePackage, exdir = sourceFolder)
+  sourcePath <- list.dirs(sourceFolder, full.names = TRUE, recursive = FALSE)
+  docDir <- file.path(sourcePath, "inst", "doc")
+  if (dir.exists(docDir)) {
+    unlink(docDir, recursive = TRUE)
+  }
+  rcmdcheck::rcmdcheck(path = sourcePath, args = c("--no-manual", "--no-multiarch"), error_on = "warning")
+}
+
+getPackageDependenciesFromGitHub <- function(package) {
+  descriptionUrlTemplate <- "https://raw.githubusercontent.com/OHDSI/%s/main/DESCRIPTION"
+
+  description <- scan(sprintf(descriptionUrlTemplate, package), what = character(), sep = "|", quiet = TRUE) 
+  dependencies <- lapply(X = c("Depends", "Imports", "LinkingTo", "Suggests"), 
+                         FUN = extractDependenciesFromDescriptionSection, 
+                         description = description)
+  dependencies <- do.call(rbind, dependencies)
+  dependencies <- dependencies[dependencies$dependency != "R", ]
+  coreRPackages <- rownames(installed.packages(priority = "base"))
+  dependencies <- dependencies[!dependencies$dependency %in% coreRPackages, ]
+  dependencies$package <- rep(package, nrow(dependencies))
+  return(dependencies)
+}
+
+extractDependenciesFromDescriptionSection <- function(section, description) {
+  tagsPos <- grep(":", description)
+  sectionPos <- grep(sprintf("%s:", section), description)
+  if (length(sectionPos) != 0) {
+    endOfSection <- ifelse(sectionPos < max(tagsPos), min(tagsPos[tagsPos > sectionPos]), length(description) + 1)
+    dependencies <- gsub("[\t ,]|(\\(.*\\))", "", gsub(sprintf("%s:", section), "", description[sectionPos:(endOfSection - 1)]))
+    dependencies <- dependencies[dependencies != ""]
+    if (length(dependencies) > 0) {
+      return(data.frame(type = section,
+                        dependency = dependencies))
+    } 
+  }
+  return(NULL)
+}

extras/Releasing/README.md

@@ -0,0 +1,13 @@
+Creating a HADES-wide release
+=============================
+
+Here you'll find the scripts used to create HADES-wide releases. A HADES-wide release is a snapshot of HADES and all of its dependencies at a specific point in time, and can form the stable basis for study packages, etc.
+
+The following R code is executed in order:
+
+1. **CreateRenvLockFile.R** is used to create the renv lock file for all of HADES and its dependencies.
+2. **SetupPython.R** prepares Python for running those unit tests that require Python.
+3. **RunCheckOnAllHadesPackages.R** runs R check on each HADES package using the renv lock file, to ensure it is complete, and all HADES packages work with the dependencies captured in the lock file.
+4. **ReleaseLockFile.R** copy the lock file into the `/hadesWideReleases` folder. The subfolder will be named after the date the renv lock file was created.
+
+

extras/Releasing/ReleaseLockFile.R

@@ -0,0 +1,6 @@
+creationTime <- file.info("renv.lock")$ctime
+
+folder <- file.path("..", "..", "hadesWideReleases", format(creationTime,"%Y%b%d"))
+dir.create(folder)
+file.copy(from = "renv.lock", to = folder)
+

extras/Releasing/Releasing.Rproj

@@ -0,0 +1,13 @@
+Version: 1.0
+
+RestoreWorkspace: Default
+SaveWorkspace: Default
+AlwaysSaveHistory: Default
+
+EnableCodeIndexing: Yes
+UseSpacesForTab: Yes
+NumSpacesForTab: 2
+Encoding: UTF-8
+
+RnwWeave: Sweave
+LaTeX: pdfLaTeX

extras/Releasing/RunCheckOnAllHadesPackages.R

@@ -0,0 +1,18 @@
+# To verify: run R check on each HADES package 
+
+install.packages("rcmdcheck")
+
+source("PackageCheckFunctions.R")
+saveRDS(prepareForPackageCheck(), "Dependencies.rds")
+dependencies <- readRDS("Dependencies.rds")
+# Skipping Hydra, as renv seems to clash with skeleton renv environments:
+dependencies <- dependencies[dependencies$name != "Hydra", ]
+for (i in 25:nrow(dependencies)) {
+  if (dependencies$name[i] == "CohortGenerator") {
+    # Delete RedShift files from JDBC drivers folder, at least until this is released: https://github.com/OHDSI/DatabaseConnector/commit/c7e3e9b8dab2b04bebadfcf34f2049a23de66dac
+    toDelete <- list.files(Sys.getenv("DATABASECONNECTOR_JAR_FOLDER"), "Redshift", full.names = TRUE)
+    unlink(toDelete, force = TRUE)
+  }
+  checkPackage(package = dependencies$name[i], inCran = dependencies$inCran[i])
+}
+unlink("Dependencies.rds")

extras/Releasing/SetupPython.R

@@ -0,0 +1,42 @@
+# Code to work around renv bugs relating to Python
+
+# Install all required dependencies --------------------------------------------
+packages <- c("scikit-survival","numpy","scipy","scikit-learn", "pandas","pydotplus","joblib", "sklearn-json")
+reticulate::conda_install(
+  envname='base', 
+  packages = packages, 
+  forge = TRUE, 
+  pip = FALSE, 
+  pip_ignore_installed = TRUE, 
+  conda = "auto"
+)
+reticulate::conda_install(
+  envname='r-reticulate', 
+  packages = packages, 
+  forge = TRUE, 
+  pip = FALSE, 
+  pip_ignore_installed = TRUE, 
+  conda = "auto"
+  )
+reticulate::use_condaenv("base")
+torch::install_torch()
+reticulate::use_condaenv("r-reticulate")
+torch::install_torch()
+
+# Copy Python from global to renv ----------------------------------------------
+
+# Under some (poorly understood) circumstances, reticulate creates a duplicate
+# r-reticulate environment. Use this code to copy all libraries from the main one
+# to the new one:
+envs <- reticulate::conda_list()
+envs <- envs[envs$name == 'r-reticulate', ]
+message(sprintf("Good r-reticulate: %s", envs$python[1]))
+message(sprintf("Evil r-reticulate: %s", envs$python[2]))
+# TODO: this somehow creates a r-reticulate folder in the r-reticulate folder. Need to fix
+unlink(dirname(envs$python[2]), recursive = TRUE)
+dir.create(dirname(envs$python[2]))
+file.copy(
+  from = dirname(envs$python[1]),
+  to = dirname(envs$python[2]),
+  recursive = TRUE
+)