Merge pull request #529 from remlapmot/v0-6-5

TwoSampleMR 0.6.5

.github/workflows/check-full.yaml

@@ -25,9 +25,7 @@ jobs:
           - {os: ubuntu-latest,   r: 'devel', http-user-agent: 'release'}
           - {os: ubuntu-latest,   r: 'release'}
           - {os: ubuntu-latest,   r: 'oldrel-1'}
-          - {os: ubuntu-latest,   r: 'oldrel-2'}
-          - {os: ubuntu-latest,   r: 'oldrel-3'}
-          - {os: ubuntu-latest,   r: 'oldrel-4'}
+          - {os: ubuntu-latest,   r: '4.3.2'}
 
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
@@ -48,10 +46,7 @@ jobs:
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:
           extra-packages: >
-            any::rcmdcheck,
-            randomForest=?ignore-before-r=4.1.0,
-            car=?ignore-before-r=4.4.0,
-            MendelianRandomization=?ignore-before-r=4.4.0
+            any::rcmdcheck
           needs: check
 
       - name: Create and populate .Renviron file

.github/workflows/test-coverage.yaml

@@ -24,7 +24,7 @@ jobs:
 
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:
-          extra-packages: any::covr
+          extra-packages: any::covr, any::xml2
           needs: coverage
 
       - name: Create and populate .Renviron file
@@ -34,15 +34,22 @@ jobs:
 
       - name: Test coverage
         run: |
-          token <- Sys.getenv("CODECOV_TOKEN", "")
-          covr::codecov(
+          cov <- covr::package_coverage(
             quiet = FALSE,
             clean = FALSE,
-            install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package"),
-            token = if (token != "") token
+            install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package")
           )
+          covr::to_cobertura(cov)
         shell: Rscript {0}
 
+      - uses: codecov/codecov-action@v4
+        with:
+          fail_ci_if_error: ${{ github.event_name != 'pull_request' && true || false }}
+          file: ./cobertura.xml
+          plugin: noop
+          disable_search: true
+          token: ${{ secrets.CODECOV_TOKEN }}
+
       - name: Show testthat output
         if: always()
         run: |

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: TwoSampleMR
 Title: Two Sample MR Functions and Interface to MR Base Database
-Version: 0.6.4
+Version: 0.6.5
 Authors@R: c(
     person("Gibran", "Hemani", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-0920-1055")),
@@ -69,4 +69,4 @@ Remotes:
     WSpiller/RadialMR
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2

NEWS.md

@@ -1,9 +1,16 @@
+# TwoSampleMR v0.6.5
+
+(Release date: 2024-06-30)
+
+* Bumped version of **roxygen2** for creating package documentation
+* Update the earliest version of R in the `R CMD check` GitHub Actions workflow to be 4.3.2. This is because the **meta** dependency depends on **lme4**, and the recent 1.1-35.4 release of **lme4** requires **Matrix** 1.6-2 which was released a few days after R 4.3.2.
+* Made package tests more robust to non-response from the OpenGWAS API
+
 # TwoSampleMR v0.6.4
 
 (Release date: 2024-06-05)
 
 * Update installation instructions in README.md
-
 * Fixed a bug in which the wrong indels recoding function was called (thanks @ruochiz)
 
 # TwoSampleMR v0.6.3

R/moe.R

@@ -171,9 +171,9 @@ get_rsq <- function(dat)
 #' \dontrun{
 #' # Example of body mass index on coronary heart disease
 #' # Extract and harmonise data
-#' a <- extract_instruments(2)
+#' a <- extract_instruments("ieu-a-2")
 #' b <- extract_outcome_data(a$SNP, 7)
-#' dat <- harmonise_data(a,b)
+#' dat <- harmonise_data(a, b)
 #' 
 #' # Apply all MR methods
 #' r <- mr_wrapper(dat)

tests/testthat/test_add_metadata.r

@@ -1,5 +1,9 @@
 context("add metadata")
 
+skip_if_offline()
+skip_if_offline(host = "api.opengwas.io")
+skip_on_cran()
+
 # get required data
 # d1 <- extract_instruments('ieu-a-2')
 # d2 <- extract_instruments(c('ieu-a-2', 'ieu-a-7'))
@@ -18,65 +22,65 @@ context("add metadata")
 load(system.file("extdata", "test_add_metadata.RData", package="TwoSampleMR"))
 
 test_that("exposure data 1", {
-  skip("Skip unless you have good access to the API.")
-	d1 <- d1 %>% add_metadata()
+	d1 <- try(d1 %>% add_metadata())
+	if (class(d1) == "try-error") skip("Server issues")
 	expect_true("units.exposure" %in% names(d1))
 })
 
 test_that("exposure data 2", {
-  skip("Skip unless you have good access to the API.")
-	d2 <- d2 %>% add_metadata()
+	d2 <- try(d2 %>% add_metadata())
+	if (class(d2) == "try-error") skip("Server issues")
 	expect_true("units.exposure" %in% names(d2))
 })
 
 test_that("outcome data 1", {
-  skip("Skip unless you have good access to the API.")
-	d3 <- d3 %>% add_metadata()
+	d3 <- try(d3 %>% add_metadata())
+	if (class(d3) == "try-error") skip("Server issues")
 	expect_true("units.outcome" %in% names(d3))
 })
 
 test_that("outcome data 2", {
-  skip("Skip unless you have good access to the API.")
-	d4 <- d4 %>% add_metadata()
+	d4 <- try(d4 %>% add_metadata())
+	if (class(d4) == "try-error") skip("Server issues")
 	expect_true("units.outcome" %in% names(d4))
 })
 
 test_that("dat 2", {
-  skip("Skip unless you have good access to the API.")
-	d5 <- d5 %>% add_metadata()
+	d5 <- try(d5 %>% add_metadata())
+	if (class(d5) == "try-error") skip("Server issues")
 	expect_true("units.outcome" %in% names(d5) & "units.exposure" %in% names(d5))
 })
 
 test_that("no id1", {
-  skip("Skip unless you have good access to the API.")
 	d6$id.exposure <- "not a real id"
-	d6 <- add_metadata(d6)
+	d6 <- try(add_metadata(d6))
+	if (class(d6) == "try-error") skip("Server issues")
 	expect_true(!"units.exposure" %in% names(d6))
 })
 
 test_that("no id2", {
-  skip("Skip unless you have good access to the API.")
 	d7$id.outcome <- "not a real id"
-	d7 <- add_metadata(d7)
+	d7 <- try(add_metadata(d7))
+	if (class(d7) == "try-error") skip("Server issues")
 	expect_true(!"units.outcome" %in% names(d7))
 })
 
 test_that("ukb-d", {
-  skip("Skip unless you have good access to the API.")
-	d8 <- add_metadata(d8)
+	d8 <- try(add_metadata(d8))
+	if (class(d8) == "try-error") skip("Server issues")
 	expect_true("units.outcome" %in% names(d8))
 })
 
 test_that("bbj-a-1", {
-  skip("Skip unless you have good access to the API.")
-	d9 <- d9 %>% add_metadata()
+	d9 <- try(d9 %>% add_metadata())
+	if (class(d9) == "try-error") skip("Server issues")
 	expect_true("samplesize.exposure" %in% names(d9))
 	expect_true(all(!is.na(d9$samplesize.exposure)))
 })
 
 test_that("ieu-b-109", {
-  skip("Skip unless you have good access to the API.")
-	d10 <- d10 %>% add_metadata()
+	d10 <- try(d10 %>% add_metadata())
+	if (class(d10) == "try-error") skip("Server issues")
 	expect_true("samplesize.exposure" %in% names(d10))
 	expect_true(all(!is.na(d10$samplesize.exposure)))
 })

tests/testthat/test_eve.R

@@ -3,7 +3,6 @@ context("eve")
 # dat <- make_dat("ieu-a-2", "ieu-a-7") %>% add_metadata()
 load(system.file("extdata", "test_commondata.RData", package="TwoSampleMR"))
 
-
 test_that("wrapper", {
   skip_if_not_installed("car")
 	expect_warning(w <- mr_wrapper(dat))

tests/testthat/test_harmonise_edge_cases.R

@@ -6,7 +6,6 @@ set.seed(1)
 old <- options(stringsAsFactors = FALSE)
 on.exit(options(old), add = TRUE)
 
-
 df <- data.frame(
     "SNP" = c("9_69001927_C_T", "9_69459263_A_G", "9_69508544_G_A"),
     "effect_allele" = c("T", "G", "A"),
@@ -47,7 +46,6 @@ df_out <- format_data(
     samplesize_col = "n"
 )
 
-
 test_that("harmonise_data works when exposure and outcome df are 1 row.", {
     for (i in seq(1,3)) {
         result <- harmonise_data(
@@ -59,7 +57,6 @@ test_that("harmonise_data works when exposure and outcome df are 1 row.", {
     }
 })
 
-
 test_that("harmonise_data works when there are no matching SNPs.", {
     for (i in seq(1,3)) {
         df_out$SNP <- paste(df_out$SNP, "foo", sep = "_")

tests/testthat/test_instruments.R

@@ -1,39 +1,61 @@
 context("Instruments")
 
-test_that("server and mrinstruments", {
+skip_if_offline()
+skip_if_offline(host = "api.opengwas.io")
+skip_on_cran()
 
-  skip("Skip unless you have good access to the API.")
-
+test_that("server and mrinstruments 1", {
 	# no no
-	exp_dat <- extract_instruments(outcomes=c("ieu-a-1032"))
+  exp_dat <- try(extract_instruments(outcomes=c("ieu-a-1032")))
+  if (class(exp_dat) == "try-error") skip("Server issues")
 	expect_true(length(unique(exp_dat$id)) == 0)
+})
+
 
+test_that("server and mrinstruments 2", {
 	# no yes
-	exp_dat <- extract_instruments(outcomes=c("ebi-a-GCST004634"))
+	exp_dat <- try(extract_instruments(outcomes=c("ebi-a-GCST004634")))
+	if (class(exp_dat) == "try-error") skip("Server issues")
 	expect_true(length(unique(exp_dat$id)) == 1)
-
+})
+
+test_that("server and mrinstruments 3", {
 	# yes no
-	exp_dat <- extract_instruments(outcomes=c("ieu-a-2", "ieu-a-1032"))
+	exp_dat <- try(extract_instruments(outcomes=c("ieu-a-2", "ieu-a-1032")))
+	if (class(exp_dat) == "try-error") skip("Server issues")
 	expect_true(length(unique(exp_dat$id)) == 1)
+})
 
+test_that("server and mrinstruments 4", {
 	# yes yes
-	exp_dat <- extract_instruments(outcomes=c("ieu-a-2", "ebi-a-GCST004634"))
+	exp_dat <- try(extract_instruments(outcomes=c("ieu-a-2", "ebi-a-GCST004634")))
+	if (class(exp_dat) == "try-error") skip("Server issues")
 	expect_true(length(unique(exp_dat$id)) == 2)
+})
 
-	exp_dat <- extract_instruments(outcomes=c("ieu-a-1032", "ebi-a-GCST004634"))
+test_that("server and mrinstruments 5", {
+	exp_dat <- try(extract_instruments(outcomes=c("ieu-a-1032", "ebi-a-GCST004634")))
+	if (class(exp_dat) == "try-error") skip("Server issues")
 	expect_true(length(unique(exp_dat$id)) == 1)
+})
 
-	exp_dat <- extract_instruments(outcomes=c(2,100,"ieu-a-1032",104,72,999))
+test_that("server and mrinstruments 6", {
+	exp_dat <- try(extract_instruments(outcomes=c(2,100,"ieu-a-1032",104,72,999)))
+	if (class(exp_dat) == "try-error") skip("Server issues")
 	expect_true(length(unique(exp_dat$id)) == 5)
+})
 
-	exp_dat <- extract_instruments(outcomes=c(2,100,"ieu-a-1032",104,72,999, "ebi-a-GCST004634"))
+test_that("server and mrinstruments 7", {
+	exp_dat <- try(extract_instruments(outcomes=c(2,100,"ieu-a-1032",104,72,999, "ebi-a-GCST004634")))
+	if (class(exp_dat) == "try-error") skip("Server issues")
 	expect_true(length(unique(exp_dat$id)) == 6)
 })
 
 load(system.file("extdata", "test_commondata.RData", package="TwoSampleMR"))
 
 test_that("read data", {
-	# exp_dat <- extract_instruments("ieu-a-2")
+	exp_dat <- try(extract_instruments("ieu-a-2"))
+	if (class(exp_dat) == "try-error") skip("Server issues")
 	names(exp_dat) <- gsub(".exposure", "", names(exp_dat))
 	fn <- tempfile()
 	write.table(exp_dat, file=fn, row=FALSE, col=TRUE, qu=FALSE, sep="\t")

tests/testthat/test_ld.R

@@ -1,46 +1,43 @@
 context("ld")
 
-test_that("extract some data", {
-  skip("Skip unless you have good access to the API.")
-  skip_on_ci()
-  skip_on_cran()
-  a <- extract_instruments(2, clump=FALSE)
-  out <- clump_data(a)
-})
+skip_if_offline()
+skip_if_offline(host = "api.opengwas.io")
+skip_on_cran()
+
+# extract some data
+a <- try(extract_instruments("ieu-a-2", clump=FALSE))
+if (class(a) == "try-error") skip("Server issues")
+out <- try(clump_data(a))
+if (class(out) == "try-error") skip("Server issues")
+
 
 test_that("clump", {
-  skip("Skip unless you have good access to the API.")
-	skip_on_ci()
-	skip_on_cran()
+  skip_if_not(exists('a'), "a not created in test above")
+  skip_if_not(exists('out'), "out not created in test above")
 	expect_equal(ncol(a), ncol(out))
 	expect_true(nrow(a) > nrow(out))
 	expect_true(nrow(out) > 0)
 })
 
 
 test_that("matrix", {
-  skip("Skip unless you have good access to the API.")
-	skip_on_ci()
-	skip_on_cran()
-	b <- ld_matrix(out$SNP)
+  skip_if_not(exists('out'), "out not created in test above")
+	b <- try(ld_matrix(out$SNP))
+	if (inherits(b, "try-error")) skip("Server issues")
 	expect_equal(nrow(b), nrow(out))
 	expect_equal(ncol(b), nrow(out))
 })
 
 
 test_that("clump multiple", {
-  skip("Skip unless you have good access to the API.")
-	skip_on_ci()
-	skip_on_cran()
-	a <- extract_instruments(c("ieu-a-2", "ieu-a-1001"), clump=FALSE)
+	a <- try(extract_instruments(c("ieu-a-2", "ieu-a-1001"), clump=FALSE))
+	if (class(a) == "try-error") skip("Server issues")
 	out <- clump_data(a)
 	expect_equal(length(unique(a$id.exposure)), length(unique(out$id.exposure)))
 })
 
 test_that("clump local", {
-  skip("Skip unless you're GH running this test locally.")
-	skip_on_ci()
-	skip_on_cran()
+  skip_if_not(exists('a'), "a not created in test above")
 	skip_if_not(file.exists("/Users/gh13047/repo/opengwas-api-internal/opengwas-api/app/ld_files/EUR.bim"))
 	aclump <- clump_data(a, bfile="/Users/gh13047/repo/opengwas-api-internal/opengwas-api/app/ld_files/EUR", plink_bin="plink")
 })

tests/testthat/test_ldsc.R

@@ -4,7 +4,9 @@ context("LDSC")
 test_that("get afl2", {
 	skip("Very slow")
 	hm3info <- ieugwasr::afl2_list("hapmap3")
+	if(inherits(hm3info, "response")) skip("Server issues")
 	s <- ieugwasr::afl2_list()
+	if(inherits(s, "response")) skip("Server issues")
 	a <- ldsc_h2("ieu-a-2", snpinfo=hm3info)
 	b <- ldsc_rg("ieu-a-2", "ieu-a-2", snpinfo=hm3info)
 	c <- ldsc_rg("ukb-a-248", "ukb-b-19953", snpinfo=hm3info)