diff --git a/.github/workflows/check-full.yaml b/.github/workflows/check-full.yaml index 4785740b..196eceba 100644 --- a/.github/workflows/check-full.yaml +++ b/.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 diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index 8b5140c2..ca096091 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.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: | diff --git a/DESCRIPTION b/DESCRIPTION index d80fffcc..efe14bee 100644 --- a/DESCRIPTION +++ b/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", , "g.hemani@bristol.ac.uk", 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 diff --git a/NEWS.md b/NEWS.md index 1eddb855..eb289b4f 100644 --- a/NEWS.md +++ b/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 diff --git a/R/moe.R b/R/moe.R index 0aeaff11..b723436f 100644 --- a/R/moe.R +++ b/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) diff --git a/man/mr_moe.Rd b/man/mr_moe.Rd index bf8348e0..dcd79ac9 100644 --- a/man/mr_moe.Rd +++ b/man/mr_moe.Rd @@ -32,9 +32,9 @@ Note that the mixture of experts has only been trained on datasets with at least \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) diff --git a/tests/testthat/test_add_metadata.r b/tests/testthat/test_add_metadata.r index 925c8c2e..7aa71c54 100644 --- a/tests/testthat/test_add_metadata.r +++ b/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))) }) diff --git a/tests/testthat/test_eve.R b/tests/testthat/test_eve.R index 92b213f6..9f0623c2 100644 --- a/tests/testthat/test_eve.R +++ b/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)) diff --git a/tests/testthat/test_harmonise_edge_cases.R b/tests/testthat/test_harmonise_edge_cases.R index 987ccf63..e2c7288f 100644 --- a/tests/testthat/test_harmonise_edge_cases.R +++ b/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 = "_") diff --git a/tests/testthat/test_instruments.R b/tests/testthat/test_instruments.R index 222a470e..0d2a5c06 100644 --- a/tests/testthat/test_instruments.R +++ b/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") diff --git a/tests/testthat/test_ld.R b/tests/testthat/test_ld.R index dccbc938..c763218c 100644 --- a/tests/testthat/test_ld.R +++ b/tests/testthat/test_ld.R @@ -1,17 +1,19 @@ 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) @@ -19,28 +21,23 @@ test_that("clump", { 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") }) diff --git a/tests/testthat/test_ldsc.R b/tests/testthat/test_ldsc.R index 290a9796..4d8b9f19 100644 --- a/tests/testthat/test_ldsc.R +++ b/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) diff --git a/tests/testthat/test_mvmr.R b/tests/testthat/test_mvmr.R index e217db6b..b74ee7e1 100644 --- a/tests/testthat/test_mvmr.R +++ b/tests/testthat/test_mvmr.R @@ -1,12 +1,16 @@ context("mvmr") +skip_on_cran() +skip_if_offline() +skip_if_offline(host = "api.opengwas.io") + test_that("control", { - skip("Skip unless you have good access to the API.") - skip_on_ci() - skip_on_cran() - lipids <- mv_extract_exposures(c("ieu-a-299","ieu-a-300","ieu-a-302")) - chd <- extract_outcome_data(lipids$SNP, "ieu-a-7") - control <- mv_harmonise_data(lipids, chd) + lipids <- try(mv_extract_exposures(c("ieu-a-299","ieu-a-300","ieu-a-302"))) + if (inherits(lipids, "try-error")) skip("Server issues") + chd <- try(extract_outcome_data(lipids$SNP, "ieu-a-7")) + if (inherits(chd, "try-error")) skip("Server issues") + control <- try(mv_harmonise_data(lipids, chd)) + if (inherits(control, "try-error")) skip("Server issues") expect_output(print(mv_residual(control, intercept=TRUE, instrument_specific=TRUE))) expect_output(print(mv_residual(control, intercept=FALSE, instrument_specific=TRUE))) expect_output(print(mv_residual(control, intercept=TRUE, instrument_specific=FALSE))) @@ -19,12 +23,12 @@ test_that("control", { test_that("dat", { - skip("Skip unless you have good access to the API.") - skip_on_ci() - skip_on_cran() - a <- mv_extract_exposures(c("ukb-b-5238", "ieu-a-1001")) - b <- extract_outcome_data(a$SNP, "ieu-a-297") - dat <- mv_harmonise_data(a, b) + a <- try(mv_extract_exposures(c("ukb-b-5238", "ieu-a-1001"))) + if (inherits(a, "try-error")) skip("Server issues") + b <- try(extract_outcome_data(a$SNP, "ieu-a-297")) + if (inherits(b, "try-error")) skip("Server issues") + dat <- try(mv_harmonise_data(a, b)) + if (inherits(dat, "try-error")) skip("Server issues") expect_output(print(mv_residual(dat, intercept=TRUE, instrument_specific=TRUE))) expect_output(print(mv_residual(dat, intercept=FALSE, instrument_specific=TRUE))) expect_output(print(mv_residual(dat, intercept=TRUE, instrument_specific=FALSE))) @@ -38,17 +42,22 @@ test_that("dat", { }) -test_that("ordering", { - skip("Skip unless you have good access to the API.") - skip_on_ci() - skip_on_cran() - lipids1 <- mv_extract_exposures(c("ieu-a-299","ieu-a-300","ieu-a-302")) - chd1 <- extract_outcome_data(lipids1$SNP, "ieu-a-7") - control1 <- mv_harmonise_data(lipids1, chd1) +test_that("ordering 1", { + lipids1 <- try(mv_extract_exposures(c("ieu-a-299","ieu-a-300","ieu-a-302"))) + if (inherits(lipids1, "try-error")) skip("Server issues") + chd1 <- try(extract_outcome_data(lipids1$SNP, "ieu-a-7")) + if (inherits(chd1, "try-error")) skip("Server issues") + control1 <- try(mv_harmonise_data(lipids1, chd1)) + if (inherits(control1, "try-error")) skip("Server issues") expect_output(print(mv_multiple(control1))) +}) - lipids2 <- mv_extract_exposures(c("ieu-a-302","ieu-a-300","ieu-a-299")) - chd2 <- extract_outcome_data(lipids2$SNP, "ieu-a-7") - control2 <- mv_harmonise_data(lipids2, chd2) +test_that("ordering 2", { + lipids2 <- try(mv_extract_exposures(c("ieu-a-302","ieu-a-300","ieu-a-299"))) + if (inherits(lipids2, "try-error")) skip("Server issues") + chd2 <- try(extract_outcome_data(lipids2$SNP, "ieu-a-7")) + if (inherits(chd2, "try-error")) skip("Server issues") + control2 <- try(mv_harmonise_data(lipids2, chd2)) + if (inherits(control2, "try-error")) skip("Server issues") expect_output(print(mv_multiple(control2))) }) diff --git a/tests/testthat/test_mvmr_local.R b/tests/testthat/test_mvmr_local.R index 657cbb45..4446aadb 100644 --- a/tests/testthat/test_mvmr_local.R +++ b/tests/testthat/test_mvmr_local.R @@ -10,15 +10,15 @@ context("mvmr local") load(system.file("extdata", "test_add_mvmr_local.RData", package="TwoSampleMR")) test_that("mv exposure local", { - skip("Skip unless you have good access to the API.") - skip_on_ci() + skip_if_offline() + skip_if_offline(host = "api.opengwas.io") skip_on_cran() f1 <- tempfile() f2 <- tempfile() write.table(a1, file=f1, row.names = FALSE, col.names = TRUE, quote = FALSE, sep="\t") write.table(a2, file=f2, row.names = FALSE, col.names = TRUE, quote = FALSE, sep="\t") - exposure_dat <- mv_extract_exposures_local( + exposure_dat <- try(mv_extract_exposures_local( c(f1, f2), sep = "\t", snp_col=c("rsid"), @@ -27,9 +27,11 @@ test_that("mv exposure local", { effect_allele_col=c("ea"), other_allele_col=c("nea"), pval_col=c("p") - ) + )) + if (inherits(exposure_dat, "try-error")) skip("Server issues") + expect_true(nrow(exposure_dat) > 100) - exposure_dat2 <- mv_extract_exposures_local( + exposure_dat2 <- try(mv_extract_exposures_local( list(a1, a2), sep = "\t", snp_col=c("rsid"), @@ -38,8 +40,7 @@ test_that("mv exposure local", { effect_allele_col=c("ea"), other_allele_col=c("nea"), pval_col=c("p") - ) - - expect_true(nrow(exposure_dat) > 100) + )) + if (inherits(exposure_dat2, "try-error")) skip("Server issues") expect_true(all.equal(exposure_dat, exposure_dat2)) }) diff --git a/tests/testthat/test_otherformats.R b/tests/testthat/test_otherformats.R index 21bcecaf..c469bd75 100644 --- a/tests/testthat/test_otherformats.R +++ b/tests/testthat/test_otherformats.R @@ -12,10 +12,11 @@ test_that("MRInput", { }) test_that("MRInput with cor", { - skip("Skip unless you have good access to the API.") - skip_on_ci() skip_on_cran() - expect_warning(w <- dat_to_MRInput(dat, get_correlations=TRUE)[[1]]) + skip_if_offline() + skip_if_offline(host = "api.opengwas.io") + w <- try(dat_to_MRInput(dat, get_correlations=TRUE)[[1]]) + if (inherits(w, "try-error")) skip("Server issues") expect_true(nrow(w@correlation) == length(w@betaX)) }) diff --git a/tests/testthat/test_outcomes.R b/tests/testthat/test_outcomes.R index a7f0008d..5290503b 100644 --- a/tests/testthat/test_outcomes.R +++ b/tests/testthat/test_outcomes.R @@ -1,28 +1,44 @@ context("outcome") -test_that("outcomes", { +skip_if_offline() +skip_if_offline(host = "api.opengwas.io") +skip_on_cran() - skip("Skip unless you have good access to the API.") - skip_on_ci() - skip_on_cran() +a <- try(extract_instruments("ieu-a-7")) +if(inherits(a, "try-error")) skip("Server issues") - a <- extract_instruments("ieu-a-7") - b <- extract_outcome_data(a$SNP, "ieu-a-2", proxies=FALSE) +test_that("outcomes 1", { + b <- try(extract_outcome_data(a$SNP, "ieu-a-2", proxies=FALSE)) + if(inherits(b, "try-error")) skip("Server issues") expect_true(nrow(b) < 30 & nrow(b) > 15) +}) - b <- extract_outcome_data(a$SNP, "ieu-a-2", proxies=TRUE) +test_that("outcomes 2", { + b <- try(extract_outcome_data(a$SNP, "ieu-a-2", proxies=TRUE)) + if(inherits(b, "try-error")) skip("Server issues") expect_true(nrow(b) > 30 & nrow(b) < nrow(a)) +}) - b <- extract_outcome_data(a$SNP, c("ieu-a-2", "a"), proxies=FALSE) +test_that("outcomes 3", { + b <- try(extract_outcome_data(a$SNP, c("ieu-a-2", "a"), proxies=FALSE)) + if(inherits(b, "try-error")) skip("Server issues") expect_true(nrow(b) < 30 & nrow(b) > 15) +}) +test_that("outcomes 4", { b <- extract_outcome_data(a$SNP, c("ieu-a-2", "a"), proxies=TRUE) + if(inherits(b, "try-error")) skip("Server issues") expect_true(nrow(b) > 30 & nrow(b) < nrow(a)) +}) +test_that("outcomes 5", { b <- extract_outcome_data(a$SNP, c("ieu-a-2", "ieu-a-7"), proxies=FALSE) + if(inherits(b, "try-error")) skip("Server issues") expect_true(nrow(b) > 60) +}) +test_that("outcomes 6", { b <- extract_outcome_data(a$SNP, c("ieu-a-2", "ieu-a-7"), proxies=TRUE) + if(inherits(b, "try-error")) skip("Server issues") expect_true(nrow(b) > 70) - }) diff --git a/tests/testthat/test_plots.R b/tests/testthat/test_plots.R index f050778c..c83c15fc 100644 --- a/tests/testthat/test_plots.R +++ b/tests/testthat/test_plots.R @@ -3,7 +3,7 @@ context("plots") load(system.file("extdata", "test_commondata.RData", package="TwoSampleMR")) test_that("scatter plot", { - # dat <- make_dat(2,7) + # dat <- make_dat("ieu-a-2", "ieu-a-7") m <- mr(dat, method_list="mr_ivw") p <- mr_scatter_plot(m, dat) expect_true(is.list(p)) diff --git a/tests/testthat/test_rsq.r b/tests/testthat/test_rsq.r index 9377b810..89d62984 100644 --- a/tests/testthat/test_rsq.r +++ b/tests/testthat/test_rsq.r @@ -10,8 +10,12 @@ test_that("exposure data 1", { }) test_that("exposure data 2", { - skip("Skip unless you have good access to the API.") - d <- extract_instruments(c('ieu-a-2', 'ieu-a-7')) %>% add_rsq() + skip_if_offline() + skip_if_offline(host = "api.opengwas.io") + skip_on_cran() + d <- try(extract_instruments(c('ieu-a-2', 'ieu-a-7'))) + if(inherits(d, "try-error")) skip("Server issues") + d <- d %>% add_rsq() expect_true("rsq.exposure" %in% names(d)) expect_true("effective_n.exposure" %in% names(d)) }) @@ -19,31 +23,49 @@ test_that("exposure data 2", { exposure <- exp_dat[1:5,] test_that("outcome data 1", { - skip("Skip unless you have good access to the API.") - d <- extract_outcome_data(exposure$SNP, 'ieu-a-2') %>% add_rsq() + skip_if_offline() + skip_if_offline(host = "api.opengwas.io") + skip_on_cran() + skip_on_ci() + d <- try(extract_outcome_data(exposure$SNP, 'ieu-a-2')) + if(inherits(d, "try-error")) skip("Server issues") + d <- try(d %>% add_rsq()) + if (inherits(d, "try-error")) skip("Server issues") expect_true("rsq.outcome" %in% names(d)) expect_true("effective_n.outcome" %in% names(d)) }) test_that("outcome data 2", { - skip("Skip unless you have good access to the API") - d <- extract_outcome_data(exposure$SNP, c('ieu-a-2', 'ieu-a-7')) %>% add_rsq() + skip_if_offline() + skip_if_offline(host = "api.opengwas.io") + skip_on_cran() + skip_on_ci() + d <- try(extract_outcome_data(exposure$SNP, c('ieu-a-2', 'ieu-a-7'))) + if(inherits(d, "try-error")) skip("Server issues") + d <- try(d %>% add_rsq()) + if(inherits(d, "try-error")) skip("Server issues") expect_true("rsq.outcome" %in% names(d)) expect_true("effective_n.outcome" %in% names(d)) }) test_that("dat 2", { - skip("Skip unless you have good access to the API.") - d <- make_dat(proxies=FALSE) %>% add_rsq() + skip_if_offline() + skip_if_offline(host = "api.opengwas.io") + skip_on_cran() + d <- try(make_dat(proxies=FALSE)) + if(inherits(d, "try-error")) skip("Server issues") + d <- d %>% add_rsq() expect_true("rsq.outcome" %in% names(d) & "rsq.exposure" %in% names(d)) expect_true("effective_n.outcome" %in% names(d) & "effective_n.exposure" %in% names(d)) }) test_that("dat ukb-d", { - skip("Skip unless you have good access to the API.") - skip_on_ci() + skip_if_offline() + skip_if_offline(host = "api.opengwas.io") skip_on_cran() - d <- make_dat(exposure="ukb-d-30710_irnt", proxies=FALSE) %>% add_rsq() + d <- try(make_dat(exposure="ukb-d-30710_irnt", proxies=FALSE)) + if(inherits(d, "try-error")) skip("Server issues") + d <- d %>% add_rsq() expect_true("rsq.outcome" %in% names(d) & "rsq.exposure" %in% names(d)) }) @@ -55,9 +77,13 @@ test_that("effective n", { }) test_that("get_population_allele_frequency", { - skip("Skip unless you have good access to the API.") - d <- extract_instruments("ieu-a-7") - d <- add_metadata(d) + skip_if_offline() + skip_if_offline(host = "api.opengwas.io") + skip_on_cran() + d <- try(extract_instruments("ieu-a-7")) + if(inherits(d, "try-error")) skip("Server issues") + d <- try(add_metadata(d)) + if(inherits(d, "try-error")) skip("Server issues") d$eaf.exposure.controls <- get_population_allele_frequency( af = d$eaf.exposure, prop = d$ncase.exposure / (d$ncase.exposure + d$ncontrol.exposure), @@ -68,16 +94,22 @@ test_that("get_population_allele_frequency", { }) test_that("bbj-a-1", { - skip("Skip unless you have good access to the API.") - skip_on_ci() skip_on_cran() - d <- extract_instruments('bbj-a-1') %>% add_metadata() %>% add_rsq() + skip_if_offline() + skip_if_offline(host = "api.opengwas.io") + d <- try(extract_instruments('bbj-a-1')) + if(inherits(d, "try-error")) skip("Server issues") + d <- try(d %>% add_metadata() %>% add_rsq()) + if(inherits(d, "try-error")) skip("Server issues") expect_true(all(!is.na(d$rsq.exposure))) }) test_that("bsen vs pn", { - skip("Skip unless you have good access to the API.") - d <- extract_instruments("ieu-a-2") + skip_if_offline() + skip_if_offline(host = "api.opengwas.io") + skip_on_cran() + d <- try(extract_instruments("ieu-a-2")) + if(inherits(d, "try-error")) skip("Server issues") r1 <- get_r_from_bsen(d$beta.exposure, d$se.exposure, d$samplesize.exposure) r2 <- get_r_from_pn(d$pval.exposure, d$samplesize.exposure) expect_true(cor(abs(r1), r2) > 0.99) diff --git a/tests/testthat/test_singlesnp.R b/tests/testthat/test_singlesnp.R index 8ce54e3a..bc29c7f1 100644 --- a/tests/testthat/test_singlesnp.R +++ b/tests/testthat/test_singlesnp.R @@ -3,13 +3,11 @@ context("singlesnp") # dat <- make_dat("ieu-a-2", "ieu-a-7") load(system.file("extdata", "test_commondata.RData", package="TwoSampleMR")) - test_that("singlesnp", { w <- mr_singlesnp(dat) expect_true(nrow(w) == sum(dat$mr_keep) + 2) }) - test_that("singlesnp_plot", { w <- mr_singlesnp(dat) p <- mr_forest_plot(w) diff --git a/tests/testthat/test_steiger.R b/tests/testthat/test_steiger.R index 7740e952..582dabf4 100644 --- a/tests/testthat/test_steiger.R +++ b/tests/testthat/test_steiger.R @@ -1,22 +1,19 @@ context("steiger") -# w <- make_dat(2, 7) +# dat <- make_dat("ieu-a-2", "ieu-a-7") load(system.file("extdata", "test_commondata.RData", package="TwoSampleMR")) - test_that("directionality", { o <- directionality_test(dat) expect_true(nrow(o) == 1) }) - test_that("directionality cc", { dat$r.outcome <- get_r_from_lor(dat$beta.outcome, dat$eaf.outcome, dat$samplesize.outcome/2, dat$samplesize.outcome/2, 0.1) o <- directionality_test(dat) expect_true(nrow(o) == 1) }) - test_that("steiger filtering", { expect_warning(dat <- steiger_filtering(dat)) expect_true("steiger_pval" %in% names(dat))