Merge pull request #532 from remlapmot/v0-6-6-before-and-and

TwoSampleMR 0.6.6

Author: remlapmot

.Rbuildignore

@@ -17,3 +17,4 @@ cache$
 ^README\.Rmd$
 ^CITATION\.cff$
 ^README\.html$
+^\.lintr$

.github/workflows/check-full.yaml

@@ -1,3 +1,9 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+#
+# NOTE: This workflow is overkill for most R packages and
+# check-standard.yaml is likely a better choice.
+# usethis::use_github_action("check-standard") will install it.
 on:
   push:
     branches: [main, master]
@@ -9,6 +15,8 @@ on:
 
 name: R-CMD-check
 
+permissions: read-all
+
 jobs:
   R-CMD-check:
     runs-on: ${{ matrix.config.os }}
@@ -57,5 +65,5 @@ jobs:
       - uses: r-lib/actions/check-r-package@v2
         with:
           upload-snapshots: true
-          args: 'c("--no-manual", "--as-cran")'
+          build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")'
           error-on: '"error"'

.github/workflows/pkgdown.yaml

@@ -11,6 +11,8 @@ on:
 
 name: pkgdown
 
+permissions: read-all
+
 jobs:
   pkgdown:
     runs-on: ubuntu-latest

.github/workflows/test-coverage.yaml

@@ -1,3 +1,5 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
 on:
   push:
     branches: [main, master]
@@ -7,6 +9,8 @@ on:
 
 name: test-coverage
 
+permissions: read-all
+
 jobs:
   test-coverage:
     runs-on: macOS-latest

.lintr

@@ -0,0 +1,16 @@
+linters: linters_with_defaults(
+    line_length_linter = NULL,
+    commented_code_linter = NULL,
+    indentation_linter = NULL,
+    trailing_whitespace_linter = NULL,
+    infix_spaces_linter = NULL,
+    quotes_linter = NULL,
+    trailing_blank_lines_linter = NULL,
+    brace_linter = NULL,
+    commas_linter = NULL,
+    whitespace_linter = NULL,
+    object_name_linter = NULL,
+    assignment_linter = NULL,
+    cyclocomp_linter = NULL
+  )
+encoding: "UTF-8"

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: TwoSampleMR
 Title: Two Sample MR Functions and Interface to MR Base Database
-Version: 0.6.5
+Version: 0.6.6
 Authors@R: c(
     person("Gibran", "Hemani", , "g.hemani@bristol.ac.uk", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-0920-1055")),
@@ -36,7 +36,7 @@ Imports:
     glmnet,
     gridExtra,
     gtable,
-    ieugwasr (>= 1.0.0),
+    ieugwasr (>= 1.0.1),
     jsonlite,
     knitr,
     lattice,
@@ -59,7 +59,8 @@ Suggests:
     MendelianRandomization,
     MRInstruments,
     randomForest,
-    testthat
+    testthat,
+    tidyr
 VignetteBuilder: 
     knitr
 Remotes:

NEWS.md

@@ -1,3 +1,13 @@
+# TwoSampleMR v0.6.6
+
+(Release date 2024-07-06)
+
+* Improve a test
+* Improve permissions in GitHub Actions workflows
+* Bump minimum required version of **ieugwasr** to 1.0.1
+* Made some amends to the code to bring it more in line with **lintr** recommendations
+* Added omitted **tidyr** soft dependency
+
 # TwoSampleMR v0.6.5
 
 (Release date: 2024-06-30)

R/add_metadata.r

@@ -15,22 +15,22 @@ add_metadata <- function(dat, cols = c("sample_size", "ncase", "ncontrol", "unit
 	get_info <- function(id, what="exposure", cols)
 	{
 		info <- ieugwasr::gwasinfo(id)
-		if(nrow(info) == 0)
+		if (nrow(info) == 0)
 		{
 			message(what, ": none of the IDs found in database")
 			return(NULL)
 		}
-		for(col in cols)
+		for (col in cols)
 		{
-			if(!col %in% names(info))
+			if (!col %in% names(info))
 			{
 				info[[col]] <- NA
 			}
 		}
 		info <- subset(info, select=c("id", cols))
 		names(info) <- paste0(names(info), ".", what)
 		names(info)[names(info) == paste0("sample_size.", what)] <- paste0("samplesize.", what)
-		if("sample_size" %in% cols)
+		if ("sample_size" %in% cols)
 		{
 			index <- grepl("ukb-d", info$id) & is.na(info[[paste0("samplesize.", what)]])
 			info[[paste0("samplesize.", what)]][index] <- 300000
@@ -39,42 +39,42 @@ add_metadata <- function(dat, cols = c("sample_size", "ncase", "ncontrol", "unit
 	}
 
 	order_col <- random_string()
-	dat[[order_col]] <- 1:nrow(dat)
-	if("id.exposure" %in% names(dat))
+	dat[[order_col]] <- seq_len(nrow(dat))
+	if ("id.exposure" %in% names(dat))
 	{
 		exposure_id <- unique(dat[["id.exposure"]])
 		info <- get_info(id=exposure_id, what="exposure", cols=cols)
-		if(!is.null(info))
+		if (!is.null(info))
 		{
-			for(x in names(info))
+			for (x in names(info))
 			{
-				if(! x %in% names(dat))
+				if (! x %in% names(dat))
 				{
 					dat[[x]] <- NA
 				}
 
-				for(id in unique(info[["id.exposure"]]))
+				for (id in unique(info[["id.exposure"]]))
 				{
 					dat[[x]][is.na(dat[[x]]) & dat[["id.exposure"]] == id] <- info[[x]][info[["id.exposure"]] == id]
 				}
 			}
 		}
 	}
 
-	if("id.outcome" %in% names(dat))
+	if ("id.outcome" %in% names(dat))
 	{
 		outcome_id <- unique(dat[["id.outcome"]])
 		info <- get_info(id=outcome_id, what="outcome", cols=cols)
-		if(!is.null(info))
+		if (!is.null(info))
 		{
-			for(x in names(info))
+			for (x in names(info))
 			{
-				if(! x %in% names(dat))
+				if (! x %in% names(dat))
 				{
 					dat[[x]] <- NA
 				}
 
-				for(id in unique(info[["id.outcome"]]))
+				for (id in unique(info[["id.outcome"]]))
 				{
 					dat[[x]][is.na(dat[[x]]) & dat[["id.outcome"]] == id] <- info[[x]][info[["id.outcome"]] == id]
 				}

R/add_rsq.r

@@ -68,7 +68,7 @@ add_rsq_one <- function(dat, what="exposure")
 			} else {
 				message("Try adding metadata with add_metadata()")
 			}
-		} else if(all(grepl("SD", dat[[paste0("units.", what)]])) & all(!is.na(dat[[paste0("eaf.", what)]]))) {
+		} else if(all(grepl("SD", dat[[paste0("units.", what)]])) && all(!is.na(dat[[paste0("eaf.", what)]]))) {
 			dat[[paste0("rsq.", what)]] <- NA
 			dat[[paste0("rsq.", what)]] <- 2 * dat[[paste0("beta.", what)]]^2 * dat[[paste0("eaf.", what)]] * (1-dat[[paste0("eaf.", what)]])
 			dat[[paste0("effective_n.", what)]] <- dat[[paste0("samplesize.", what)]]
@@ -109,12 +109,19 @@ get_r_from_pn_less_accurate <- function(p, n)
 
 test_r_from_pn <- function()
 {
+  if (!requireNamespace("tidyr", quietly = TRUE)) {
+    stop(
+      "Package \"tidyr\" must be installed to use this function.",
+      call. = FALSE
+    )
+  }	
+
 	param <- expand.grid(
 		n = c(10, 100, 1000, 10000, 100000),
 		rsq = 10^seq(-4,-0.5, length.out=30)
 	)
 
-	for(i in 1:nrow(param))
+	for(i in seq_len(nrow(param)))
 	{
 		message(i)
 		x <- scale(stats::rnorm(param$n[i]))
@@ -125,7 +132,7 @@ test_r_from_pn <- function()
 		param$rsq2[i] <- get_r_from_pn(param$pval[i], param$n[i])^2
 	}
 
-	param <- gather(param, key=out, value=value, rsq1, rsq2)
+	param <- tidyr::gather(param, key=out, value=value, rsq1, rsq2)
 
 	p <- ggplot2::ggplot(param, ggplot2::aes(x=rsq_emp, value)) +
 	  ggplot2::geom_abline(slope=1, linetype="dotted") +
@@ -170,7 +177,7 @@ get_r_from_pn <- function(p, n)
 		abs(-log10(suppressWarnings(get_p_from_r2n(x, sample_size))) - -log10(pvalue))
 	}
 
-	if(length(p) > 1 & length(n) == 1)
+	if(length(p) > 1 && length(n) == 1)
 	{
 		message("Assuming n the same for all p values")
 		n <- rep(n, length(p))
@@ -182,7 +189,7 @@ get_r_from_pn <- function(p, n)
 	if(any(index))
 	{
 		index <- which(index)
-		for(i in 1:length(index))
+		for(i in seq_along(index))
 		{
 			if(p[index[i]] == 0)
 			{
@@ -240,15 +247,15 @@ get_r_from_lor <- function(lor, af, ncase, ncontrol, prevalence, model="logit",
 	stopifnot(length(ncase) == 1 | length(ncase) == length(lor))
 	stopifnot(length(ncontrol) == 1 | length(ncontrol) == length(lor))
 	stopifnot(length(prevalence) == 1 | length(prevalence) == length(lor))
-	if(length(prevalence) == 1 & length(lor) != 1)
+	if(length(prevalence) == 1 && length(lor) != 1)
 	{
 		prevalence <- rep(prevalence, length(lor))
 	}
-	if(length(ncase) == 1 & length(lor) != 1)
+	if(length(ncase) == 1 && length(lor) != 1)
 	{
 		ncase <- rep(ncase, length(lor))
 	}
-	if(length(ncontrol) == 1 & length(lor) != 1)
+	if(length(ncontrol) == 1 && length(lor) != 1)
 	{
 		ncontrol <- rep(ncontrol, length(lor))
 	}
@@ -340,7 +347,7 @@ get_population_allele_frequency <- function(af, prop, odds_ratio, prevalence)
 {
 	stopifnot(length(af) == length(odds_ratio))
 	stopifnot(length(prop) == length(odds_ratio))
-	for(i in 1:length(odds_ratio))
+	for(i in seq_along(odds_ratio))
 	{
 		co <- contingency(af[i], prop[i], odds_ratio[i])
 		af_controls <- co[1,2] / (co[1,2] + co[2,2])

R/forest_plot.R

@@ -162,7 +162,7 @@ mr_forest_plot_grouped <-
                     data_Fm$eff_col <- log(as.numeric(data_Fm[,eff_col]))
                 }
                 # ggplot code to generate the forest plot using geom_segments and geom_points and to make a relatively minimal theme
-                raw_forest  <- ggplot(data = data_Fm, aes( y = space_col, yend = space_col, x = as.numeric(lb_col), xend = as.numeric(ub_col) )) + geom_segment() + geom_point(aes( y = space_col,  x = as.numeric(eff_col), size = 4 )) + theme_bw() + theme( axis.text.y = element_blank(), axis.ticks.y = element_blank(), axis.title = element_blank(), panel.grid = element_blank(), rect = element_blank(), title = element_text(size = 23), legend.position = 'none' ) + expand_limits(y = c(data_Fm[,space_col] - 1, data_Fm[,space_col] + 2)) + labs(title = title_text) # returns ggplot2 object with the (un-annotated) forest plot
+                raw_forest  <- ggplot2::ggplot(data = data_Fm, ggplot2::aes( y = space_col, yend = space_col, x = as.numeric(lb_col), xend = as.numeric(ub_col) )) + ggplot2::geom_segment() + ggplot2::geom_point(ggplot2::aes( y = space_col,  x = as.numeric(eff_col), size = 4 )) + ggplot2::theme_bw() + ggplot2::theme( axis.text.y = ggplot2::element_blank(), axis.ticks.y = ggplot2::element_blank(), axis.title = ggplot2::element_blank(), panel.grid = ggplot2::element_blank(), rect = ggplot2::element_blank(), title = ggplot2::element_text(size = 23), legend.position = 'none') + ggplot2::expand_limits(y = c(data_Fm[,space_col] - 1, data_Fm[,space_col] + 2)) + ggplot2::labs(title = title_text) # returns ggplot2 object with the (un-annotated) forest plot
                 return(raw_forest)
             }
 
@@ -183,7 +183,7 @@ mr_forest_plot_grouped <-
                 text_widths <- c(-1, max(10,0.5 * max(sapply( as.character(data_Fm[,text_col]),nchar ))))
 
                 # GGplot rendering of the annotation column
-                lefttext  <- ggplot(data = data_Fm, aes( y = space_col, x = 0, label = text_col, fontface = attr_list )) + geom_text(hjust = 0) + theme_bw() + theme( axis.text.y = element_blank(), axis.ticks.y = element_blank(),axis.text.x = element_text(colour = "white"),axis.ticks.x = element_line(colour = "white"), axis.title = element_blank(), rect = element_blank(), panel.grid = element_blank(), title = element_text(size = 23) ) + expand_limits(x = text_widths,  y = c(data_Fm[,space_col] - 1, data_Fm[,space_col] + 2)) + labs(title = title_text, size = 40)  # returns two-item list with left_text, the GGplot annotations, and text_widths, the x-axis limits of the plot
+                lefttext  <- ggplot2::ggplot(data = data_Fm, ggplot2::aes( y = space_col, x = 0, label = text_col, fontface = attr_list )) + ggplot2::geom_text(hjust = 0) + ggplot2::theme_bw() + ggplot2::theme( axis.text.y = ggplot2::element_blank(), axis.ticks.y = ggplot2::element_blank(),axis.text.x = ggplot2::element_text(colour = "white"),axis.ticks.x = ggplot2::element_line(colour = "white"), axis.title = ggplot2::element_blank(), rect = ggplot2::element_blank(), panel.grid = ggplot2::element_blank(), title = ggplot2::element_text(size = 23) ) + ggplot2::expand_limits(x = text_widths,  y = c(data_Fm[,space_col] - 1, data_Fm[,space_col] + 2)) + ggplot2::labs(title = title_text, size = 40)  # returns two-item list with left_text, the GGplot annotations, and text_widths, the x-axis limits of the plot
                 return(list(left_text = lefttext, text_widths = text_widths))
             }
 
@@ -201,7 +201,7 @@ mr_forest_plot_grouped <-
                     title_list <- col_names
                 }
 
-                for (i in 1:length(col_names)) {
+                for (i in seq_along(col_names)) {
                     # loop to get the widths of each annotation column and to group the annotation objects together
                     col <- anot_col( data_Fm = data_Fm, text_col = col_names[i], space_col = space_col, title_text = title_list[[i]] )
                     relative_widths[i] <- col$text_widths[2] - col$text_widths[1]
@@ -230,7 +230,7 @@ mr_forest_plot_grouped <-
             left_Grobs <- left_Hs
             left_Grobs$relative_widths <- NULL
 
-            for (i in 1:length(left_Grobs)) {
+            for (i in seq_along(left_Grobs)) {
                 grob_Bag[paste('l',names(left_Grobs)[i],sep = '')] <- left_Grobs[i]
             }
 
@@ -239,7 +239,7 @@ mr_forest_plot_grouped <-
             right_RW <- right_Hs$relative_widths
             right_Grobs <- right_Hs
             right_Grobs$relative_widths <- NULL
-            for (i in 1:length(right_Grobs)) {
+            for (i in seq_along(right_Grobs)) {
                 grob_Bag[paste('r',names(right_Grobs)[i], sep = '')] <- right_Grobs[i]
             }