Compare ⋅ mrcieu/ieugwasr

#' @param access_token Google OAuth2 access token. Used to authenticate level of access to data. By default, checks if already authenticated through \code{get_access_token} and if not then does not perform authentication
#' @param method GET (default) or POST, DELETE etc
#' @param silent TRUE/FALSE to be passed to httr call. TRUE by default
#' @param encode Default = json, see httr::POST for options
#' @param timeout Default = 300, avoid increasing this, preferentially simplify the query first.
#'
#' @export
#' @return httr response object
api_query <- function(path, query=NULL, access_token=check_access_token(), method="GET", silent=TRUE)
api_query <- function(path, query=NULL, access_token=check_access_token(), method="GET", silent=TRUE, encode="json", timeout=300)
{
	ntry <- 0
	ntries <- 5

@@ -20,6 +22,8 @@

Loading

		'X-Api-Source'=ifelse(is.null(options()$mrbase.environment), 'R/TwoSampleMR', 'mr-base-shiny')
	)

	retry_flag <- FALSE

	while(ntry <= ntries)
	{
		if(method == "DELETE")

@@ -28,7 +32,7 @@

Loading

				httr::DELETE(
					paste0(options()$ieugwasr_api, path),
					headers,
					httr::timeout(300)
					httr::timeout(timeout)
				),
				silent=TRUE
			)

@@ -38,8 +42,8 @@

Loading

					paste0(options()$ieugwasr_api, path),
					body = query, 
					headers,
					encode="json",
					httr::timeout(300)
					encode=encode,
					httr::timeout(timeout)
				),
				silent=TRUE
			)

@@ -48,7 +52,7 @@

Loading

				httr::GET(
					paste0(options()$ieugwasr_api, path),
					headers,
					httr::timeout(300)
					httr::timeout(timeout)
				),
				silent=TRUE
			)			

@@ -57,21 +61,33 @@

Loading

		{
			if(grepl("Timeout", as.character(attributes(r)$condition)))
			{
				stop("The query to MR-Base exceeded 300 seconds and timed out. Please simplify the query")
				stop("The query to MR-Base exceeded ", timeout, " seconds and timed out. Please simplify the query")
			}
		}
		if(! 'try-error' %in% class(r))
		{
			if(r$status_code != 503)
			if(r$status_code >= 500 & r$status_code < 600)
			{
				break
			} else {
				message("Server is probably experiencing traffic, trying again...")
				message("Server code: ", r$status_code, "; Server is possibly experiencing traffic, trying again...")
				retry_flag <- TRUE
				Sys.sleep(1)
			} else {
				if(retry_flag)
				{
					message("Retry succeeded!")
				}
				break
			}
		}
		ntry <- ntry + 1
	}

	if(r$status_code >= 500 & r$status_code < 600)
	{
		message("Server error: ", r$status_code)
		message("Failed to retrieve results from server. See error status message in the returned object and contact the developers if the problem persists.")
		return(r)
	}
	if('try-error' %in% class(r))
	{
		if(grepl("Could not resolve host", as.character(attributes(r)$condition)))

@@ -151,7 +167,7 @@

Loading

		return(dplyr::tibble())
	}
	out <- dplyr::bind_rows(out) %>%
		dplyr::select("id", "trait", "sample_size", "nsnp", "year", "consortium", "author", dplyr::everything())
		dplyr::select("id", "trait", dplyr::everything())
	class(out) <- c("GwasInfo", class(out))
	return(out)
}

@@ -161,13 +177,17 @@

Loading

	dplyr::glimpse(x)
}

batch <- function(x) UseMethod("batch", x)
batch.GwasInfo <- function(x)
#' Extract batch name from study ID
#'
#' @param id Array of study IDs
#'
#' @export
#' @return Array of batch names
batch_from_id <- function(id)
{
	sapply(strsplit(x[["id"]], "-"), function(x) paste(x[1], x[2], sep="-"))
	sapply(strsplit(id, "-"), function(x) paste(x[1], x[2], sep="-"))
}


#' Get list of data batches in IEU GWAS database
#'
#'

@@ -300,3 +320,20 @@

Loading

300	320		}
301	321		}
302	322
	323	+
	324	+	#' Check datasets that are in process of being uploaded
	325	+	#'
	326	+	#' @param id ID
	327	+	#' @param access_token Google OAuth2 access token. Used to authenticate level of access to data. By default, checks if already authenticated through \code{get_access_token} and if not then does not perform authentication
	328	+	#'
	329	+	#' @export
	330	+	#' @return Dataframe
	331	+	editcheck <- function(id, access_token=check_access_token())
	332	+	{
	333	+	api <- options()[["ieugwasr_api"]]
	334	+	select_api("private")
	335	+	out <- api_query(paste0("edit/check/", id), access_token=access_token) %>%
	336	+	get_query_content()
	337	+	options(ieugwasr_api=api)
	338	+	return(out)
	339	+	}

@@ -6,7 +6,7 @@

Loading

#' @param clump_kb Clumping kb window. Default is very strict, 10000
#' @param clump_r2 Clumping r2 threshold. Default is very strict, 0.001
#' @param clump_p Clumping sig level for index variants. Default = 1 (i.e. no threshold)
#' @param pop Super-population to use as reference panel. Default = "EUR". Options are EUR, SAS, EAS, AFR, AMR
#' @param pop Super-population to use as reference panel. Default = "EUR". Options are EUR, SAS, EAS, AFR, AMR. 'legacy' also available - which is a previously used verison of the EUR panel with a slightly different set of markers
#' @param access_token Google OAuth2 access token. Used to authenticate level of access to data
#' @param bfile If this is provided then will use the API. Default = NULL
#' @param plink_bin If null and bfile is not null then will detect packaged plink binary for specific OS. Otherwise specify path to plink binary. Default = NULL

@@ -19,6 +19,11 @@

Loading

	stopifnot("rsid" %in% names(dat))
	stopifnot(is.data.frame(dat))

	if(is.null(bfile))
	{
		message("Please look at vignettes for options on running this locally if you need to run many instances of this command.")
	}

	if(! "pval" %in% names(dat))
	{
		if( "p" %in% names(dat))

@@ -6,7 +6,7 @@

Loading

#'
#' @param variants List of variants (rsids)
#' @param with_alleles Whether to append the allele names to the SNP names. Default: TRUE
#' @param pop Super-population to use as reference panel. Default = "EUR". Options are EUR, SAS, EAS, AFR, AMR
#' @param pop Super-population to use as reference panel. Default = "EUR". Options are EUR, SAS, EAS, AFR, AMR. 'legacy' also available - which is a previously used verison of the EUR panel with a slightly different set of markers
#' @param bfile If this is provided then will use the API. Default = NULL
#' @param plink_bin If null and bfile is not null then will detect packaged plink binary for specific OS. Otherwise specify path to plink binary. Default = NULL
#'

@@ -16,9 +16,15 @@

Loading

{
	if(length(variants) > 500 & is.null(bfile))
	{
		stop("SNP list must be smaller than 500. Try running locally by providing local ld reference with bfile argument")
		stop("SNP list must be smaller than 500. Try running locally by providing local ld reference with bfile argument. See vignettes for a guide on how to do this.")
	}

	if(is.null(bfile))
	{
		message("Please look at vignettes for options on running this locally if you need to run many instances of this command.")
	}


	if(!is.null(bfile))
	{
		return(ld_matrix_local(variants, bfile=bfile, plink_bin=plink_bin, with_alleles=with_alleles))

Everything is accounted for!

No changes detected that need to be reviewed.

What changes does Codecov check for?

Lines, not adjusted in diff, that have changed coverage data.

Files that introduced coverage data that had none before.

Files that have missing coverage data that once were tracked.

62.15% 100.00% ø

updated

explodecomputer

d3e0def

Hiding 10 contexual commits

+17

+13

+4

d6eea03

Files		•	•	•	Coverage
R	+17	+13	ø	+4	^0.71% 62.15%
Project Totals (7 files)	362	225	0	137	62.15%

57	61		{
58	62		if(grepl("Timeout", as.character(attributes(r)$condition)))
59	63		{
60		-	stop("The query to MR-Base exceeded 300 seconds and timed out. Please simplify the query")
	64	+	stop("The query to MR-Base exceeded ", timeout, " seconds and timed out. Please simplify the query")
61	65		}
62	66		}
63	67		if(! 'try-error' %in% class(r))
64	68		{
65		-	if(r$status_code != 503)
	69	+	if(r$status_code >= 500 & r$status_code < 600)
66	70		{
67		-	break
68		-	} else {
69		-	message("Server is probably experiencing traffic, trying again...")
	71	+	message("Server code: ", r$status_code, "; Server is possibly experiencing traffic, trying again...")
	72	+	retry_flag <- TRUE
70	73		Sys.sleep(1)
	74	+	} else {
	75	+	if(retry_flag)
	76	+	{
	77	+	message("Retry succeeded!")
	78	+	}
	79	+	break
71	80		}
72	81		}
73	82		ntry <- ntry + 1
74	83		}
	84	+
	85	+	if(r$status_code >= 500 & r$status_code < 600)
	86	+	{
	87	+	message("Server error: ", r$status_code)
	88	+	message("Failed to retrieve results from server. See error status message in the returned object and contact the developers if the problem persists.")
	89	+	return(r)
	90	+	}
75	91		if('try-error' %in% class(r))
76	92		{
77	93		if(grepl("Could not resolve host", as.character(attributes(r)$condition)))

151	167		return(dplyr::tibble())
152	168		}
153	169		out <- dplyr::bind_rows(out) %>%
154		-	dplyr::select("id", "trait", "sample_size", "nsnp", "year", "consortium", "author", dplyr::everything())
	170	+	dplyr::select("id", "trait", dplyr::everything())
155	171		class(out) <- c("GwasInfo", class(out))
156	172		return(out)
157	173		}

161	177		dplyr::glimpse(x)
162	178		}
163	179
164		-	batch <- function(x) UseMethod("batch", x)
165		-	batch.GwasInfo <- function(x)
	180	+	#' Extract batch name from study ID
	181	+	#'
	182	+	#' @param id Array of study IDs
	183	+	#'
	184	+	#' @export
	185	+	#' @return Array of batch names
	186	+	batch_from_id <- function(id)
166	187		{
167		-	sapply(strsplit(x[["id"]], "-"), function(x) paste(x[1], x[2], sep="-"))
	188	+	sapply(strsplit(id, "-"), function(x) paste(x[1], x[2], sep="-"))
168	189		}
169	190
170		-
171	191		#' Get list of data batches in IEU GWAS database
172	192		#'
173	193		#'

Navigation	Overlay
`t` Navigate files	`h` Toggle hits
`y` Change url to tip of branch	`m` Toggle misses
`b / v` Jump to prev/next hit line	`p` Toggle partial
`z / x` Jump to prev/next missed or partial line	`1..9` Toggle flags
`shift + o` Open current page in GitHub	`a` Toggle all on
`/ or ?` Show keyboard shortcuts dialog	`c` Toggle context lines or commits

Compare `d6eea03 ... +10 ... d3e0def`

No flags found

Everything is accounted for!

What changes does Codecov check for?

Show failed CI and contexual commits `c`

12 Commits

7	7		#' @param access_token Google OAuth2 access token. Used to authenticate level of access to data. By default, checks if already authenticated through \code{get_access_token} and if not then does not perform authentication
8	8		#' @param method GET (default) or POST, DELETE etc
9	9		#' @param silent TRUE/FALSE to be passed to httr call. TRUE by default
	10	+	#' @param encode Default = json, see httr::POST for options
	11	+	#' @param timeout Default = 300, avoid increasing this, preferentially simplify the query first.
10	12		#'
11	13		#' @export
12	14		#' @return httr response object
13		-	api_query <- function(path, query=NULL, access_token=check_access_token(), method="GET", silent=TRUE)
	15	+	api_query <- function(path, query=NULL, access_token=check_access_token(), method="GET", silent=TRUE, encode="json", timeout=300)
14	16		{
15	17		ntry <- 0
16	18		ntries <- 5

20	22		'X-Api-Source'=ifelse(is.null(options()$mrbase.environment), 'R/TwoSampleMR', 'mr-base-shiny')
21	23		)
22	24
	25	+	retry_flag <- FALSE
	26	+
23	27		while(ntry <= ntries)
24	28		{
25	29		if(method == "DELETE")

28	32		httr::DELETE(
29	33		paste0(options()$ieugwasr_api, path),
30	34		headers,
31		-	httr::timeout(300)
	35	+	httr::timeout(timeout)
32	36		),
33	37		silent=TRUE
34	38		)

38	42		paste0(options()$ieugwasr_api, path),
39	43		body = query,
40	44		headers,
41		-	encode="json",
42		-	httr::timeout(300)
	45	+	encode=encode,
	46	+	httr::timeout(timeout)
43	47		),
44	48		silent=TRUE
45	49		)

48	52		httr::GET(
49	53		paste0(options()$ieugwasr_api, path),
50	54		headers,
51		-	httr::timeout(300)
	55	+	httr::timeout(timeout)
52	56		),
53	57		silent=TRUE
54	58		)

6	6		#' @param clump_kb Clumping kb window. Default is very strict, 10000
7	7		#' @param clump_r2 Clumping r2 threshold. Default is very strict, 0.001
8	8		#' @param clump_p Clumping sig level for index variants. Default = 1 (i.e. no threshold)
9		-	#' @param pop Super-population to use as reference panel. Default = "EUR". Options are EUR, SAS, EAS, AFR, AMR
	9	+	#' @param pop Super-population to use as reference panel. Default = "EUR". Options are EUR, SAS, EAS, AFR, AMR. 'legacy' also available - which is a previously used verison of the EUR panel with a slightly different set of markers
10	10		#' @param access_token Google OAuth2 access token. Used to authenticate level of access to data
11	11		#' @param bfile If this is provided then will use the API. Default = NULL
12	12		#' @param plink_bin If null and bfile is not null then will detect packaged plink binary for specific OS. Otherwise specify path to plink binary. Default = NULL

19	19		stopifnot("rsid" %in% names(dat))
20	20		stopifnot(is.data.frame(dat))
21	21
	22	+	if(is.null(bfile))
	23	+	{
	24	+	message("Please look at vignettes for options on running this locally if you need to run many instances of this command.")
	25	+	}
	26	+
22	27		if(! "pval" %in% names(dat))
23	28		{
24	29		if( "p" %in% names(dat))

6	6		#'
7	7		#' @param variants List of variants (rsids)
8	8		#' @param with_alleles Whether to append the allele names to the SNP names. Default: TRUE
9		-	#' @param pop Super-population to use as reference panel. Default = "EUR". Options are EUR, SAS, EAS, AFR, AMR
	9	+	#' @param pop Super-population to use as reference panel. Default = "EUR". Options are EUR, SAS, EAS, AFR, AMR. 'legacy' also available - which is a previously used verison of the EUR panel with a slightly different set of markers
10	10		#' @param bfile If this is provided then will use the API. Default = NULL
11	11		#' @param plink_bin If null and bfile is not null then will detect packaged plink binary for specific OS. Otherwise specify path to plink binary. Default = NULL
12	12		#'

16	16		{
17	17		if(length(variants) > 500 & is.null(bfile))
18	18		{
19		-	stop("SNP list must be smaller than 500. Try running locally by providing local ld reference with bfile argument")
	19	+	stop("SNP list must be smaller than 500. Try running locally by providing local ld reference with bfile argument. See vignettes for a guide on how to do this.")
20	20		}
21	21
	22	+	if(is.null(bfile))
	23	+	{
	24	+	message("Please look at vignettes for options on running this locally if you need to run many instances of this command.")
	25	+	}
	26	+
	27	+
22	28		if(!is.null(bfile))
23	29		{
24	30		return(ld_matrix_local(variants, bfile=bfile, plink_bin=plink_bin, with_alleles=with_alleles))

Compare d6eea03 ... +10 ... d3e0def

No flags found

Everything is accounted for!

What changes does Codecov check for?

Show failed CI and contexual commits c 12 Commits

Compare `d6eea03 ... +10 ... d3e0def`

Show failed CI and contexual commits `c`

12 Commits