Updating to align with changes in ieugwasr

- Changed error handling - now if the API gives an error code it is propagated as an error with message in TwoSampleMR
- Headers sent to API are updated

Author: explodecomputer

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: TwoSampleMR
 Title: Two Sample MR Functions and Interface to MRC Integrative
     Epidemiology Unit OpenGWAS Database
-Version: 0.6.19
+Version: 0.6.20
 Authors@R: c(
     person("Gibran", "Hemani", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-0920-1055")),
@@ -34,7 +34,7 @@ Imports:
     glmnet,
     gridExtra,
     gtable,
-    ieugwasr (>= 1.0.1),
+    ieugwasr (>= 1.1.0),
     jsonlite,
     knitr,
     lattice,
@@ -64,6 +64,7 @@ VignetteBuilder:
 Remotes:
     gqi/MRMix,
     mrcieu/MRInstruments,
+    mrcieu/ieugwasr,
     MRPRESSO=rondolab/MR-PRESSO,
     qingyuanzhao/mr.raps,
     WSpiller/RadialMR

R/instruments.R

@@ -19,7 +19,7 @@ extract_instruments <- function(outcomes, p1 = 5e-8, clump = TRUE, p2 = 5e-8, r2
 	# .Deprecated("ieugwasr::tophits()")
 	outcomes <- ieugwasr::legacy_ids(unique(outcomes))
 
-	d <- ieugwasr::tophits(outcomes, pval=p1, clump=clump, r2=r2, kb=kb, force_server=FALSE, opengwas_jwt=opengwas_jwt)
+	d <- ieugwasr::tophits(outcomes, pval=p1, clump=clump, r2=r2, kb=kb, force_server=FALSE, opengwas_jwt=opengwas_jwt, x_api_source=x_api_source_header())
 
 	# d$phenotype.deprecated <- paste0(d$trait, " || ", d$consortium, " || ", d$year, " || ", d$unit)
 	if(nrow(d) == 0) return(NULL)

R/ld.R

@@ -89,5 +89,5 @@ clump_data <- function(dat, clump_kb=10000, clump_r2=0.001, clump_p1=1, clump_p2
 ld_matrix <- function(snps, with_alleles=TRUE, pop="EUR")
 {
 	# .Deprecated("ieugwasr::ld_matrix()")
-	ieugwasr::ld_matrix(variants=snps, with_alleles=with_alleles, pop=pop)
+	ieugwasr::ld_matrix(variants=snps, with_alleles=with_alleles, pop=pop, x_api_source=x_api_source_header())
 }

R/ldsc.r

@@ -118,14 +118,14 @@ ldsc_rg_internal <- function(Zs, r2, h1, h2, N1, N2, Nc=0, W=NULL)
 ldsc_h2 <- function(id, ancestry="infer", snpinfo = NULL, splitsize=20000)
 {
     if (is.null(snpinfo)) {
-        snpinfo <- ieugwasr::afl2_list("hapmap3")
+        snpinfo <- ieugwasr::afl2_list("hapmap3", x_api_source=x_api_source_header())
     }
 
     snpinfo <- snpinfo %>%
         dplyr::filter(complete.cases(.))
 
     d <- extract_split(snpinfo$rsid, id, splitsize) %>%
-        ieugwasr::fill_n() %>%
+        ieugwasr::fill_n(x_api_source=x_api_source_header()) %>%
         dplyr::mutate(z = beta / se) %>%
         dplyr::select(rsid, z = z, n = n, eaf) %>%
         dplyr::filter(complete.cases(.))
@@ -159,20 +159,20 @@ ldsc_h2 <- function(id, ancestry="infer", snpinfo = NULL, splitsize=20000)
 ldsc_rg <- function(id1, id2, ancestry="infer", snpinfo = NULL, splitsize=20000)
 {
     if (is.null(snpinfo)) {
-        snpinfo <- ieugwasr::afl2_list("hapmap3")
+        snpinfo <- ieugwasr::afl2_list("hapmap3", x_api_source=x_api_source_header())
     }
 
     x <- extract_split(snpinfo$rsid, c(id1, id2), splitsize)
     d1 <- subset(x, id == id1) %>%
-        ieugwasr::fill_n() %>%
+        ieugwasr::fill_n(x_api_source=x_api_source_header()) %>%
         dplyr::mutate(z = beta / se) %>%
         dplyr::select(rsid, z1 = z, n1 = n, eaf) %>%
         dplyr::filter(complete.cases(.))
 
     stopifnot(nrow(d1) > 0)
 
     d2 <- subset(x, id == id2) %>%
-        ieugwasr::fill_n() %>%
+        ieugwasr::fill_n(x_api_source=x_api_source_header()) %>%
         dplyr::mutate(z = beta / se) %>%
         dplyr::select(rsid, z2 = z, n2 = n, eaf) %>%
         dplyr::filter(complete.cases(.))
@@ -234,7 +234,7 @@ extract_split <- function(snplist, id, splitsize=20000)
     split(snplist, 1:nsplit) %>%
         pbapply::pblapply(., function(x)
         {
-            ieugwasr::associations(x, id, proxies=FALSE)
+            ieugwasr::associations(x, id, proxies=FALSE, x_api_source=x_api_source_header())
         }) %>%
         dplyr::bind_rows()
 }

R/query.R

@@ -1,3 +1,9 @@
+x_api_source_header <- function()
+{
+	paste0("ieugwasr/", utils::packageVersion("ieugwasr"), ";TwoSampleMR/", utils::packageVersion("TwoSampleMR"))
+}
+
+
 #' Get list of studies with available GWAS summary statistics through API
 #'
 #' @param opengwas_jwt Used to authenticate protected endpoints. Login to <https://api.opengwas.io> to obtain a jwt. Provide the jwt string here, or store in .Renviron under the keyname OPENGWAS_JWT.
@@ -7,7 +13,7 @@
 available_outcomes <- function(opengwas_jwt = ieugwasr::get_opengwas_jwt())
 {
 	# .Deprecated("ieugwasr::gwasinfo()")
-	a <- ieugwasr::gwasinfo(opengwas_jwt=opengwas_jwt)
+	a <- ieugwasr::gwasinfo(opengwas_jwt=opengwas_jwt, x_api_source=x_api_source_header())
 	return(a)
 }
 
@@ -92,7 +98,8 @@ extract_outcome_data_internal <- function(snps, outcomes, proxies = TRUE, rsq =
 			align_alleles = align_alleles,
 			palindromes = palindromes,
 			maf_threshold = maf_threshold,
-			opengwas_jwt=opengwas_jwt
+			opengwas_jwt=opengwas_jwt,
+			x_api_source=x_api_source_header()
 		)
 		if(!is.data.frame(d)) d <- data.frame()
 
@@ -118,7 +125,8 @@ extract_outcome_data_internal <- function(snps, outcomes, proxies = TRUE, rsq =
 					align_alleles = align_alleles,
 					palindromes = palindromes,
 					maf_threshold = maf_threshold,
-					opengwas_jwt=opengwas_jwt
+					opengwas_jwt=opengwas_jwt,
+					x_api_source=x_api_source_header()
 				)
 				if(!is.data.frame(out)) out <- data.frame()
 				return(out)
@@ -149,7 +157,8 @@ extract_outcome_data_internal <- function(snps, outcomes, proxies = TRUE, rsq =
 					align_alleles = align_alleles,
 					palindromes = palindromes,
 					maf_threshold = maf_threshold,
-					opengwas_jwt=opengwas_jwt
+					opengwas_jwt=opengwas_jwt,
+					x_api_source=x_api_source_header()
 				)
 
 				if(!is.data.frame(out)) out <- data.frame()