Skip to content

Commit

Permalink
Merge pull request #210 from jr-leary7/dev
Browse files Browse the repository at this point in the history
Dev
  • Loading branch information
jr-leary7 authored Sep 25, 2024
2 parents 75e6ffe + c5edda6 commit 938f52b
Show file tree
Hide file tree
Showing 3 changed files with 26 additions and 18 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Package: scLANE
Type: Package
Title: Model gene expression dynamics with spline-based NB GLMs, GEEs, & GLMMs
Version: 0.8.1
Version: 0.8.2
Authors@R: c(person(given = "Jack", family = "Leary", email = "[email protected]", role = c("aut", "cre"), comment = c(ORCID = "0009-0004-8821-3269")),
person(given = "Rhonda", family = "Bacher", email = "[email protected]", role = c("ctb", "fnd"), comment = c(ORCID = "0000-0001-5787-476X")))
Description: scLANE uses truncated power basis spline models to build flexible, interpretable models of single cell gene expression over pseudotime or latent time.
Expand Down
6 changes: 6 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -1,3 +1,9 @@
# Changes in version 0.8.2

+ Sped up the NB LASSSO implementation in `fitGLMM()`
+ Fixed some errors related to intercept-only `marge` models
+ Added DF and KC corrections to new function `biasCorrectGEE()`

# Changes in version 0.8.1

+ Added small-sample bias correction method to GEE sandwich variance-covariance matrix, results in smaller Wald test statistics.
Expand Down
36 changes: 19 additions & 17 deletions R/fitGLMM.R
Original file line number Diff line number Diff line change
Expand Up @@ -58,17 +58,17 @@ fitGLMM <- function(X_pred = NULL,
})
keepmods <- which(sapply(glm_marge_knots, function(x) length(x$coef_names)) > 1)
glm_marge_knots <- glm_marge_knots[keepmods]

allKnots <- lapply(glm_marge_knots, function(x) extractBreakpoints(x)$Breakpoint)
allCoef <- lapply(glm_marge_knots, function(x) names(coef(x$final_mod)[-1]))
allOldCoef <- lapply(glm_marge_knots, function(x) paste0("B_final", x$marge_coef_names[-1]))
tp_fun <- lapply(allCoef, function(x) dplyr::if_else(grepl("h_[0-9]", x), "tp2", "tp1"))
tp_fun <- lapply(allCoef, function(x) dplyr::if_else(grepl("h_[0-9]", x), "tp2", "tp1"))

glm_marge_knots <- data.frame(knot = do.call(c, allKnots),
coef = do.call(c, allCoef),
old_coef = do.call(c, allOldCoef),
tp_fun = do.call(c, tp_fun))

glmm_basis_df <- purrr::pmap_dfc(list(glm_marge_knots$knot,
glm_marge_knots$tp_fun,
seq_len(nrow(glm_marge_knots))),
Expand All @@ -88,9 +88,9 @@ fitGLMM <- function(X_pred = NULL,
" + (1 + ", paste(colnames(glmm_basis_df), collapse = " + "),
" | subject)"))
glmm_basis_df_new <- dplyr::mutate(glmm_basis_df,
Y = Y,
subject = id.vec,
.before = 1)
Y = Y,
subject = id.vec,
.before = 1)
nonzero_coefs <- 1
} else {
marge_style_names <- glm_marge_knots$old_coef
Expand All @@ -108,8 +108,9 @@ fitGLMM <- function(X_pred = NULL,
pruned_model <- mpath::glmregNB(lasso_formula,
data = glmm_basis_df,
parallel = FALSE,
nlambda = 50, penalty="snet",
alpha = .5,
nlambda = 50,
penalty = "snet",
alpha = .5,
standardize = TRUE,
trace = FALSE,
maxit.theta = 1,
Expand All @@ -119,8 +120,9 @@ fitGLMM <- function(X_pred = NULL,
data = glmm_basis_df,
offset = log(1 / Y.offset),
parallel = FALSE,
nlambda = 50, penalty="snet",
alpha = .5,
nlambda = 50,
penalty = "snet",
alpha = .5,
standardize = TRUE,
trace = FALSE,
maxit.theta = 1,
Expand All @@ -137,7 +139,7 @@ fitGLMM <- function(X_pred = NULL,
Y = Y,
subject = id.vec,
.before = 1)
}
}
if (is.null(Y.offset)) {
glmm_mod <- glmmTMB::glmmTMB(mod_formula,
data = glmm_basis_df_new,
Expand All @@ -154,11 +156,11 @@ fitGLMM <- function(X_pred = NULL,
}
} else {
glmm_basis_df_new <- data.frame(X1 = tp1(X_pred[, 1], t = round(as.numeric(stats::quantile(X_pred[, 1], 1/3)), 4)),
X2 = tp1(X_pred[, 1], t = round(as.numeric(stats::quantile(X_pred[, 1], 2/3)), 4)),
X3 = tp2(X_pred[, 1], t = round(as.numeric(stats::quantile(X_pred[, 1], 1/3)), 4)),
X4 = tp2(X_pred[, 1], t = round(as.numeric(stats::quantile(X_pred[, 1], 2/3)), 4)),
Y = Y,
subject = id.vec)
X2 = tp1(X_pred[, 1], t = round(as.numeric(stats::quantile(X_pred[, 1], 2/3)), 4)),
X3 = tp2(X_pred[, 1], t = round(as.numeric(stats::quantile(X_pred[, 1], 1/3)), 4)),
X4 = tp2(X_pred[, 1], t = round(as.numeric(stats::quantile(X_pred[, 1], 2/3)), 4)),
Y = Y,
subject = id.vec)
marge_style_names <- c(paste0("B_final(", round(as.numeric(stats::quantile(X_pred[, 1], 1/3)), 4), "-PT)"),
paste0("B_final(PT-", round(as.numeric(stats::quantile(X_pred[, 1], 1/3)), 4), ")"),
paste0("B_final(", round(as.numeric(stats::quantile(X_pred[, 1], 2/3)), 4), "-PT)"),
Expand Down

0 comments on commit 938f52b

Please sign in to comment.