TwoSampleMR 0.6.8

.github/workflows/check-full.yaml

@@ -25,6 +25,7 @@ jobs:
 
     strategy:
       fail-fast: false
+      max-parallel: 2
       matrix:
         config:
           - {os: macos-latest,   r: 'release'}

.github/workflows/test-coverage.yaml

@@ -48,7 +48,8 @@ jobs:
 
       - uses: codecov/codecov-action@v4
         with:
-          fail_ci_if_error: ${{ github.event_name != 'pull_request' && true || false }}
+          # Fail if error if not on PR, or if on PR and token is given
+          fail_ci_if_error: ${{ github.event_name != 'pull_request' || secrets.CODECOV_TOKEN }}
           file: ./cobertura.xml
           plugin: noop
           disable_search: true

.lintr

@@ -2,15 +2,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
+    cyclocomp_linter = NULL,
+    object_usage_linter = NULL,
+    spaces_left_parentheses_linter = NULL,
+    object_length_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.7
+Version: 0.6.8
 Authors@R: c(
     person("Gibran", "Hemani", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-0920-1055")),

NEWS.md

@@ -1,3 +1,10 @@
+# TwoSampleMR v0.6.8
+
+(Release date 2024-09-06)
+
+* Replaced some `unique()` calls in `power_prune()` with `mean()` to ensure scalar `iv.se` values (thanks @phageghost)
+* Slightly improved formatting of code base
+
 # TwoSampleMR v0.6.7
 
 (Release date 2024-08-21)

R/add_rsq.r

@@ -2,7 +2,7 @@
 #'
 #' Can be applied to exposure_dat, outcome_dat or harmonised_data.
 #' Note that it will be beneficial in some circumstances to add the meta data to
-#' the data object using [add_metadata()] before running this function. 
+#' the data object using [add_metadata()] before running this function.
 #' Also adds effective sample size for case control data.
 #'
 #' @param dat exposure_dat, outcome_dat or harmonised_data
@@ -76,7 +76,7 @@ add_rsq_one <- function(dat, what="exposure")
 			ind1 <- !is.na(dat[[paste0("pval.", what)]]) & !is.na(dat[[paste0("samplesize.", what)]])
 			dat[[paste0("rsq.", what)]] <- NA
 			if(sum(ind1) > 0)
-			{		
+			{
 				dat[[paste0("rsq.", what)]][ind1] <- get_r_from_bsen(
 					dat[[paste0("beta.", what)]][ind1],
 					dat[[paste0("se.", what)]][ind1],
@@ -114,7 +114,7 @@ test_r_from_pn <- function()
       "Package \"tidyr\" must be installed to use this function.",
       call. = FALSE
     )
-  }	
+  }
 
 	param <- expand.grid(
 		n = c(10, 100, 1000, 10000, 100000),
@@ -228,7 +228,7 @@ compareNA <- function(v1,v2) {
 
 #' Estimate proportion of variance of liability explained by SNP in general population
 #'
-#' This uses equation 10 in Lee et al. A Better Coefficient of Determination for Genetic Profile Analysis. 
+#' This uses equation 10 in Lee et al. A Better Coefficient of Determination for Genetic Profile Analysis.
 #' Genetic Epidemiology 36: 214–224 (2012) \doi{10.1002/gepi.21614}.
 #'
 #' @param lor Vector of Log odds ratio.
@@ -309,7 +309,7 @@ contingency <- function(af, prop, odds_ratio, eps=1e-15)
 		z <- -c_ / b
 	} else {
 		d <- b^2 - 4*a*c_
-		if (d < eps*eps) 
+		if (d < eps*eps)
 		{
 			s <- 0
 		} else {
@@ -327,7 +327,7 @@ contingency <- function(af, prop, odds_ratio, eps=1e-15)
 #' @param g Vector of 0/1/2
 #'
 #' @export
-#' @return Allele frequency 
+#' @return Allele frequency
 allele_frequency <- function(g)
 {
 	(sum(g == 1) + 2 * sum(g == 2)) / (2 * sum(!is.na(g)))

R/enrichment.R

@@ -42,7 +42,7 @@
 	a <- lapply(a, as.data.frame)
 	a <- plyr::rbind.fill(a)
 	a <- as.data.frame(lapply(a, as.character), stringsAsFactors=FALSE)
-	return(a)	
+	return(a)
 }
 
 

R/eve.R

@@ -114,8 +114,8 @@ mr_mean_egger <- function(d)
 	y2 <- ratios * weights2
 	egger2 <- summary(stats::lm(y2 ~ weights2))
 	eggeroutliers <- dplyr::tibble(
-		SNP=d$SNP, 
-		Qj = weights2^2 * (ratios - stats::coefficients(egger2)[1,1] / weights2 - stats::coefficients(egger2)[2,1])^2, 
+		SNP=d$SNP,
+		Qj = weights2^2 * (ratios - stats::coefficients(egger2)[1,1] / weights2 - stats::coefficients(egger2)[2,1])^2,
 		Qpval=stats::pchisq(Qj,1,lower.tail=FALSE)
 	)
 
@@ -209,7 +209,7 @@ mr_all <- function(dat, parameters=default_parameters())
 		m1$estimates <- dplyr::bind_rows(m1$estimates, m2, m3)
 	}
 	m1$info <- c(list(
-			id.exposure = dat$id.exposure[1], id.outcome = dat$id.outcome[1]),		
+			id.exposure = dat$id.exposure[1], id.outcome = dat$id.outcome[1]),
 			system_metrics(dat)
 		) %>% dplyr::as_tibble()
 	return(m1)

R/forest_plot.R

@@ -43,7 +43,7 @@
 #' @param decrease (logical) sort the studies by decreasing effect sizes `TRUE`/`FALSE`?
 #' @param se_Col (character) name of the column giving the standard error of the effect sizes.
 #' @param returnRobj (logical) return the graph as an internal R object `TRUE`/`FALSE`?
-#' 
+#'
 #' @keywords internal
 #' @return grid object giving the forest plot (or plot as pdf)
 mr_forest_plot_grouped <-
@@ -117,7 +117,7 @@
                     idx <- idx + 2 + n_std
                 }
                 # returns data frame giving spacings, primary annotation (content_list), typeface attributes for the primary annotation (attr_list), and  mapping between rows in forest plot and rows in meta-analytic data frame
-                return( data.frame( spacing_vec = (1 + length(spacing_vec) - spacing_vec), content_list = unlist(content_list), row_list = unlist(row_list), attr_list = unlist(attr_list) ) )
+                return(data.frame(spacing_vec = (1 + length(spacing_vec) - spacing_vec), content_list = unlist(content_list), row_list = unlist(row_list), attr_list = unlist(attr_list)))
             }
 
 
@@ -162,7 +162,7 @@
                     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  <- 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
+                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)
             }
 
@@ -180,10 +180,10 @@
                 data_Fm$text_col <- data_Fm[,text_col]
 
                 # A hard rule to set the width of the annotation column, which sometimes truncates very wide columns (complex disease names, numbers with 16 digits, etc)
-                text_widths <- c(-1, max(10,0.5 * max(sapply( as.character(data_Fm[,text_col]),nchar ))))
+                text_widths <- c(-1, max(10,0.5 * max(sapply(as.character(data_Fm[,text_col]), nchar))))
 
                 # GGplot rendering of the annotation column
-                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
+                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))
             }
 
@@ -203,7 +203,7 @@
 
                 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]] )
+                    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]
                     output[[col_names[i]]] <- ggplotGrob(col$left_text)
                 }
@@ -246,7 +246,7 @@
             width_vec <- c(left_RW,0.34,right_RW)
             width_vec <- width_vec / sum(width_vec)
             # convert the grid objects (now grouped) into a table of grid objects that can be plotted using grid.draw
-            grp_FP <- gtable::gtable_matrix( name = "groupplot", grobs = matrix(grob_Bag, nrow = 1), widths = unit(width_vec, "npc"), heights = unit(1,"npc") )
+            grp_FP <- gtable::gtable_matrix(name = "groupplot", grobs = matrix(grob_Bag, nrow = 1), widths = unit(width_vec, "npc"), heights = unit(1,"npc"))
 
             # return the grid object table, to be plotted
             return(grp_FP)
@@ -263,18 +263,18 @@
 
 
         ## order and structure effect sizes and CIs for forest plot
-        space1 <- spacer( exposure = exposure_Name, eff_col = eff_Col, outcome = outcome_Name, Data_Fm = data, decrease = decrease)
+        space1 <- spacer(exposure = exposure_Name, eff_col = eff_Col, outcome = outcome_Name, Data_Fm = data, decrease = decrease)
 
         expand_data  <- space_Out(data_Fm = data, space_Fm = space1)
 
         ## Make the forest plot
-        fo1  <- ggforest( data_Fm = expand_data, space_col = 'spacing_vec', eff_col = eff_Col, lb_col = "lb" ,ub_col = "ub", log_ES = log_ES, title_text = forest_Title )
+        fo1  <- ggforest(data_Fm = expand_data, space_col = 'spacing_vec', eff_col = eff_Col, lb_col = "lb" ,ub_col = "ub", log_ES = log_ES, title_text = forest_Title)
 
         ## Construct left-hand-side annotations
-        left <- anot_side( data_Fm = expand_data, space_col = 'spacing_vec', col_names = left_Col_Names, title_list = left_Col_Titles )
+        left <- anot_side(data_Fm = expand_data, space_col = 'spacing_vec', col_names = left_Col_Names, title_list = left_Col_Titles)
 
         ## Construct right-hand-side annotations
-        right <- anot_side( data_Fm = expand_data, space_col = 'spacing_vec', col_names = right_Col_Names, title_list = right_Col_Titles )
+        right <- anot_side(data_Fm = expand_data, space_col = 'spacing_vec', col_names = right_Col_Names, title_list = right_Col_Titles)
 
         ## group all plots together
         group <- group_Plots(forst_Pt = fo1, left_Hs = left, right_Hs = right)