diff --git a/DESCRIPTION b/DESCRIPTION index 1e12a4f9..d24b93e0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: TwoSampleMR Title: Two Sample MR Functions and Interface to MRC Integrative Epidemiology Unit OpenGWAS Database -Version: 0.7.2 +Version: 0.7.3 Authors@R: c( person("Gibran", "Hemani", , "g.hemani@bristol.ac.uk", role = c("aut", "cre"), comment = c(ORCID = "0000-0003-0920-1055")), diff --git a/NEWS.md b/NEWS.md index fb6fda5a..167424f3 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,9 @@ +# TwoSampleMR v0.7.3 + +(Release date 2026-03-31) + +* Some further code optimizations. + # TwoSampleMR v0.7.2 (Release date 2026-03-30) diff --git a/R/format_mr_results2.R b/R/format_mr_results2.R index 6be97cfe..4c6e73c2 100644 --- a/R/format_mr_results2.R +++ b/R/format_mr_results2.R @@ -146,9 +146,13 @@ combine_all_mrresults <- function( het <- het[, c("id.exposure", "id.outcome", "method", "Q", "Q_df", "Q_pval")] # Convert all factors to character - res[] <- lapply(res, function(x) if (is.factor(x)) as.character(x) else x) - het[] <- lapply(het, function(x) if (is.factor(x)) as.character(x) else x) - sin[] <- lapply(sin, function(x) if (is.factor(x)) as.character(x) else x) + factors_to_character <- function(df) { + df[] <- lapply(df, function(x) if (is.factor(x)) as.character(x) else x) + df + } + res <- factors_to_character(res) + het <- factors_to_character(het) + sin <- factors_to_character(sin) sin <- sin[grep("[:0-9:]", sin$SNP), ] sin$method <- "Wald ratio" @@ -285,10 +289,10 @@ combine_all_mrresults <- function( power_prune <- function(dat, method = 1, dist.outcome = "binary") { # dat[,c("eaf.exposure","beta.exposure","se.exposure","samplesize.outcome","ncase.outcome","ncontrol.outcome")] if (method == 1) { - L <- NULL id.sets <- paste(split_exposure(dat)$exposure, split_outcome(dat)$outcome) id.set.unique <- unique(id.sets) dat$id.set <- as.numeric(factor(id.sets)) + L <- vector("list", length(id.set.unique)) for (i in seq_along(id.set.unique)) { # print(i) print(paste( @@ -334,7 +338,7 @@ power_prune <- function(dat, method = 1, dist.outcome = "binary") { dat1 <- dat1[nexp == nexp[1], ] L[[i]] <- dat1 } - dat <- do.call(rbind, L) + dat <- data.table::rbindlist(L) dat <- dat[, !names(dat1) %in% c("id.set", "id.subset")] # if (drop.duplicates == T) { # dat<-dat[dat$power.prune=="keep",] @@ -343,17 +347,17 @@ power_prune <- function(dat, method = 1, dist.outcome = "binary") { } if (method == 2) { - L <- NULL id.sets <- paste(split_exposure(dat)$exposure, split_outcome(dat)$outcome) id.set.unique <- unique(id.sets) dat$id.set <- as.numeric(factor(id.sets)) + L <- vector("list", length(id.set.unique)) for (i in seq_along(id.set.unique)) { dat1 <- dat[id.sets == id.set.unique[i], ] # unique(dat1[,c("exposure","outcome")]) id.subset <- paste(dat1$exposure, dat1$id.exposure, dat1$outcome, dat1$id.outcome) id.subset.unique <- unique(id.subset) dat1$id.subset <- as.numeric(factor(id.subset)) - L1 <- NULL + L1 <- vector("list", length(id.subset.unique)) for (j in seq_along(id.subset.unique)) { # print(j) print(paste("identifying best powered summary set: ", id.subset.unique[j], sep = "")) @@ -405,12 +409,12 @@ power_prune <- function(dat, method = 1, dist.outcome = "binary") { # dat2$power<-power L1[[j]] <- dat2 } - L[[i]] <- do.call(rbind, L1) + L[[i]] <- data.table::rbindlist(L1) } - dat2 <- do.call(rbind, L) + dat2 <- data.table::rbindlist(L) dat2 <- dat2[order(dat2$id.set, dat2$iv.se), ] id.sets <- unique(dat2$id.set) - id.keep <- NULL + id.keep <- vector("list", length(id.sets)) for (i in seq_along(id.sets)) { # print(i) # print(id.sets[i]) @@ -450,6 +454,6 @@ size.prune <- function(dat) { dat$ncase[is.na(dat$ncase)] <- dat$samplesize[is.na(dat$ncase)] dat <- dat[order(dat$ncase, decreasing = TRUE), ] id.expout <- paste(dat$exposure, dat$outcome) - id.keep <- id.expout[!duplicated(paste(dat$exposure, dat$originalname.outcome))] + id.keep <- id.expout[!duplicated(data.frame(dat$exposure, dat$originalname.outcome))] dat <- dat[id.expout %in% id.keep, ] } diff --git a/R/harmonise.R b/R/harmonise.R index 54e9a253..75436d3f 100644 --- a/R/harmonise.R +++ b/R/harmonise.R @@ -70,7 +70,7 @@ harmonise_data <- function(exposure_dat, outcome_dat, action = 2) { combs <- subset( res.tab, - !duplicated(paste(id.exposure, id.outcome)), + !duplicated(data.frame(id.exposure, id.outcome)), select = c(id.exposure, id.outcome) ) diff --git a/R/other_formats.R b/R/other_formats.R index cee95686..ab48b67c 100644 --- a/R/other_formats.R +++ b/R/other_formats.R @@ -146,7 +146,7 @@ run_mr_presso <- function(dat, NbDistribution = 1000, SignifThreshold = 0.05) { dat <- subset(dat, mr_keep) d <- subset( dat, - !duplicated(paste(id.exposure, " - ", id.outcome)), + !duplicated(data.frame(id.exposure, id.outcome)), select = c(exposure, outcome, id.exposure, id.outcome) ) res <- list() diff --git a/R/rucker.R b/R/rucker.R index 5660c7e3..c207abfe 100644 --- a/R/rucker.R +++ b/R/rucker.R @@ -30,10 +30,10 @@ PM <- function(y = y, s = s, Alpha = 0.1) { mode <- df - 1 Quant <- c(low, mode, mn, med, up) L <- length(Quant) - Tausq <- NULL - Isq <- NULL + Tausq <- numeric(L) + Isq <- numeric(L) CI <- matrix(nrow = L, ncol = 2) - MU <- NULL + MU <- numeric(L) v <- 1 / s^2 sum.v <- sum(v) typS <- sum(v * (k - 1)) / (sum.v^2 - sum(v^2)) @@ -77,7 +77,7 @@ mr_rucker <- function(dat, parameters = default_parameters()) { dat <- subset(dat, mr_keep) d <- subset( dat, - !duplicated(paste(id.exposure, " - ", id.outcome)), + !duplicated(data.frame(id.exposure, id.outcome)), select = c(exposure, outcome, id.exposure, id.outcome) ) res <- list() @@ -409,7 +409,7 @@ mr_rucker_jackknife <- function(dat, parameters = default_parameters()) { dat <- subset(dat, mr_keep) d <- subset( dat, - !duplicated(paste(id.exposure, " - ", id.outcome)), + !duplicated(data.frame(id.exposure, id.outcome)), select = c(exposure, outcome, id.exposure, id.outcome) ) res <- list()