Skip to content

Commit

Permalink
Merge branch 'main' into reduce_methods_docs
Browse files Browse the repository at this point in the history
  • Loading branch information
@strengejacke
strengejacke authored Nov 6, 2024
2 parents 260d2e5 + 911cb38 commit 7d65eb8
Show file tree
Hide file tree
Showing 4 changed files with 22 additions and 37 deletions.
22 changes: 11 additions & 11 deletions R/clean_parameters.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -497,22 +497,22 @@ clean_parameters.mlm <- function(x, ...) {

resp_pattern <- sprintf("_%s_(.*)", resp)
for (i in resp_pattern) {
out$Cleaned_Parameter <- gsub(pattern = i, "_\\1", out$Cleaned_Parameter, perl = TRUE)
out$Cleaned_Parameter <- gsub(pattern = i, "_\\1", out$Cleaned_Parameter)
}

resp_pattern <- sprintf("__%s(.*)", resp)
for (i in resp_pattern) {
out$Cleaned_Parameter <- gsub(pattern = i, "\\1", out$Cleaned_Parameter, perl = TRUE)
out$Cleaned_Parameter <- gsub(pattern = i, "\\1", out$Cleaned_Parameter)
}

resp_pattern <- sprintf("__zi_%s(.*)", resp)
for (i in resp_pattern) {
out$Cleaned_Parameter <- gsub(pattern = i, "\\1", out$Cleaned_Parameter, perl = TRUE)
out$Cleaned_Parameter <- gsub(pattern = i, "\\1", out$Cleaned_Parameter)
}

resp_pattern <- sprintf("(sigma)(_%s)", resp)
for (i in resp_pattern) {
out$Cleaned_Parameter <- gsub(pattern = i, "\\1", out$Cleaned_Parameter, perl = TRUE)
out$Cleaned_Parameter <- gsub(pattern = i, "\\1", out$Cleaned_Parameter)
}
}

Expand All @@ -526,16 +526,16 @@ clean_parameters.mlm <- function(x, ...) {
# clean fixed effects, conditional and zero-inflated

out$Cleaned_Parameter <- gsub(pattern = "^b_(?!zi_)(.*)\\.(\\d)\\.$", "\\1[\\2]", out$Cleaned_Parameter, perl = TRUE)
out$Cleaned_Parameter <- gsub(pattern = "^b_zi_(.*)\\.(\\d)\\.$", "\\1[\\2]", out$Cleaned_Parameter, perl = TRUE)
out$Cleaned_Parameter <- gsub(pattern = "^b_zi_(.*)\\.(\\d)\\.$", "\\1[\\2]", out$Cleaned_Parameter)
out$Cleaned_Parameter <- gsub(pattern = "^(b_|bs_|bsp_|bcs_)(?!zi_)(.*)", "\\2", out$Cleaned_Parameter, perl = TRUE)
out$Cleaned_Parameter <- gsub(pattern = "^(b_zi_|bs_zi_|bsp_zi_|bcs_zi_)(.*)", "\\2", out$Cleaned_Parameter, perl = TRUE) # nolint
out$Cleaned_Parameter <- gsub(pattern = "^(b_zi_|bs_zi_|bsp_zi_|bcs_zi_)(.*)", "\\2", out$Cleaned_Parameter) # nolint

# correlation and sd

cor_sd <- grepl("(sd_|cor_)(.*)", out$Cleaned_Parameter)
if (any(cor_sd)) {
out$Cleaned_Parameter[cor_sd] <- gsub("^(sd_|cor_)(.*?)__(.*)", "\\3", out$Parameter[cor_sd], perl = TRUE)
out$Group[cor_sd] <- paste("SD/Cor:", gsub("^(sd_|cor_)(.*?)__(.*)", "\\2", out$Parameter[cor_sd], perl = TRUE))
out$Cleaned_Parameter[cor_sd] <- gsub("^(sd_|cor_)(.*?)__(.*)", "\\3", out$Parameter[cor_sd])
out$Group[cor_sd] <- paste("SD/Cor:", gsub("^(sd_|cor_)(.*?)__(.*)", "\\2", out$Parameter[cor_sd]))
# replace "__" by "~"
cor_only <- startsWith(out$Parameter[cor_sd], "cor_")
if (any(cor_only)) {
Expand Down Expand Up @@ -645,14 +645,14 @@ clean_parameters.mlm <- function(x, ...) {
cor_sd <- startsWith(out$Cleaned_Parameter, "Sigma[")

if (any(cor_sd)) {
parm1 <- gsub("^Sigma\\[(.*):(.*),(.*)\\]", "\\2", out$Parameter[cor_sd], perl = TRUE)
parm2 <- gsub("^Sigma\\[(.*):(.*),(.*)\\]", "\\3", out$Parameter[cor_sd], perl = TRUE)
parm1 <- gsub("^Sigma\\[(.*):(.*),(.*)\\]", "\\2", out$Parameter[cor_sd])
parm2 <- gsub("^Sigma\\[(.*):(.*),(.*)\\]", "\\3", out$Parameter[cor_sd])
out$Cleaned_Parameter[which(cor_sd)] <- parm1
rand_cor <- parm1 != parm2
if (any(rand_cor)) {
out$Cleaned_Parameter[which(cor_sd)[rand_cor]] <- paste0(parm1[rand_cor], " ~ ", parm2[rand_cor])
}
out$Group[cor_sd] <- paste("Var/Cov:", gsub("^Sigma\\[(.*):(.*),(.*)\\]", "\\1", out$Parameter[cor_sd], perl = TRUE))
out$Group[cor_sd] <- paste("Var/Cov:", gsub("^Sigma\\[(.*):(.*),(.*)\\]", "\\1", out$Parameter[cor_sd]))
}


Expand Down
14 changes: 7 additions & 7 deletions R/find_parameters_bayesian.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -225,29 +225,29 @@ find_parameters.brmsfit <- function(x,

# remove redundant columns. These seem to be new since brms 2.16?
pattern <- "^[A-z]_\\d\\.\\d\\.(.*)"
fe <- fe[!grepl(pattern, fe, perl = TRUE)]
fe <- fe[!grepl(pattern, fe)]

is_mv <- NULL

# remove "Intercept"
fe <- fe[!startsWith(fe, "Intercept")]

cond <- fe[grepl("^(b_|bs_|bsp_|bcs_)(?!zi_)(.*)", fe, perl = TRUE)]
zi <- fe[grepl("^(b_zi_|bs_zi_|bsp_zi_|bcs_zi_)", fe, perl = TRUE)]
zi <- fe[grepl("^(b_zi_|bs_zi_|bsp_zi_|bcs_zi_)", fe)]
rand <- fe[grepl("(?!.*__(zi|sigma|beta))(?=.*^r_)", fe, perl = TRUE) & !startsWith(fe, "prior_")]
randzi <- fe[grepl("^r_(.*__zi)", fe, perl = TRUE)]
randzi <- fe[grepl("^r_(.*__zi)", fe)]
rand_sd <- fe[grepl("(?!.*_zi)(?=.*^sd_)", fe, perl = TRUE)]
randzi_sd <- fe[grepl("^sd_(.*_zi)", fe, perl = TRUE)]
randzi_sd <- fe[grepl("^sd_(.*_zi)", fe)]
rand_cor <- fe[grepl("(?!.*_zi)(?=.*^cor_)", fe, perl = TRUE)]
randzi_cor <- fe[grepl("^cor_(.*_zi)", fe, perl = TRUE)]
randzi_cor <- fe[grepl("^cor_(.*_zi)", fe)]
simo <- fe[startsWith(fe, "simo_")]
car_struc <- fe[fe %in% c("car", "sdcar")]
smooth_terms <- fe[startsWith(fe, "sds_")]
priors <- fe[startsWith(fe, "prior_")]
sigma_param <- fe[startsWith(fe, "sigma_") | grepl("sigma", fe, fixed = TRUE)]
randsigma <- fe[grepl("^r_(.*__sigma)", fe, perl = TRUE)]
randsigma <- fe[grepl("^r_(.*__sigma)", fe)]
fixed_beta <- fe[grepl("beta", fe, fixed = TRUE)]
rand_beta <- fe[grepl("^r_(.*__beta)", fe, perl = TRUE)]
rand_beta <- fe[grepl("^r_(.*__beta)", fe)]
mix <- fe[grepl("mix", fe, fixed = TRUE)]
shiftprop <- fe[grepl("shiftprop", fe, fixed = TRUE)]
dispersion <- fe[grepl("dispersion", fe, fixed = TRUE)]
Expand Down
21 changes: 3 additions & 18 deletions R/helper_functions.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -364,28 +364,13 @@


.grep_zi_smoothers <- function(x) {
grepl("^(s\\.\\d\\()", x, perl = TRUE) |
grepl("^(gam::s\\.\\d\\()", x, perl = TRUE) |
grepl("^(mgcv::s\\.\\d\\()", x, perl = TRUE)
# this one captures smoothers in zi- or mv-models from gam
grepl("^(s\\.\\d\\()", x) | grepl("^(gam::s\\.\\d\\()", x) | grepl("^(mgcv::s\\.\\d\\()", x)
}


.grep_non_smoothers <- function(x) {
!startsWith(x, "s(") &
# this one captures smoothers in zi- or mv-models from gam
grepl("^(?!(s\\.\\d\\())", x, perl = TRUE) &
!startsWith(x, "ti(") &
!startsWith(x, "te(") &
!startsWith(x, "t2(") &
!startsWith(x, "gam::s(") &
!startsWith(x, "VGAM::s(") &
!startsWith(x, "mgcv::s(") &
!startsWith(x, "mgcv::ti(") &
!startsWith(x, "mgcv::t2(") &
!startsWith(x, "mgcv::te(") &
!startsWith(x, "brms::s(") &
!startsWith(x, "brms::t2") &
!startsWith(x, "smooth_sd[")
!.grep_smoothers(x) & !.grep_zi_smoothers(x)
}


Expand Down
2 changes: 1 addition & 1 deletion R/utilities.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -46,7 +46,7 @@ trim_ws <- function(x, ...) {

#' @export
trim_ws.default <- function(x, ...) {
gsub("^\\s+|\\s+$", "", x, perl = TRUE, useBytes = TRUE)
gsub("^\\s+|\\s+$", "", x, useBytes = TRUE)
}

#' @rdname trim_ws
Expand Down

0 comments on commit 7d65eb8

Please sign in to comment.