Convert lme4 double-bar syntax to MixedModels.jl zerocorr()

convert_to_zerocorr.R

library(rrapply)
expr <- y ~ x + (1 || z)
lobstr::ast(!!expr)
#> █─`~` 
#> ├─y 
#> └─█─`+` 
#>   ├─x 
#>   └─█─`(` 
#>     └─█─`||` 
#>       ├─1 
#>       └─z

# `{rrapply}`-style functions to locate replacement points in the AST
is_parens_doublebar <- function(x, .xsiblings) {
  identical(x, quote(`(`)) &&
    identical(.xsiblings[[2]][[1]], quote(`||`))
}
is_doublebar_zerocorr <- function(x, .xparents) {
  identical(x, quote(`||`)) && {
    object <- evalq(object, parent.frame())
    doublebar_parent <- as.integer(head(.xparents, -2))
    identical(object[[doublebar_parent]][[1]], quote(zerocorr))
  }
}

# Helper to return symbols to replace with
returnq <- function(x) {
  eval(substitute(function(...) quote(x)))
}

convert_to_zerocorr <- function(x) {
  x <- rrapply(x, is_parens_doublebar, f = returnq(zerocorr), how = "replace")
  x <- rrapply(x, is_doublebar_zerocorr, f = returnq(`|`), how = "replace")
  x
}
convert_to_zerocorr(expr)
#> y ~ x + zerocorr(1 | z)

Even more over-engineered version that collapses rrapply() calls:

is_parens_outside_doublebar <- function(x, .xsiblings) {
  identical(x, quote(`(`)) &&
    identical(.xsiblings[[2]][[1]], quote(`||`))
}
is_doublebar_inside_parens <- function(x, .xparents, n = 1) {
  identical(x, quote(`||`)) && {
    object <- evalq(object, parent.frame(n))
    doublebar_parent <- as.integer(head(.xparents, -2))
    list(object[[doublebar_parent]][[1]]) %in% expression(`(`, zerocorr)
  }
}
convert_to_zerocorr <- function(x) {
  if (has_doublebar(x)) {
    x <- rrapply(
      x,
      condition = function(x, .xparents, .xsiblings) {
        is_parens_outside_doublebar(x, .xsiblings) ||
          is_doublebar_inside_parens(x, .xparents, n = 2)
      },
      f = function(x) switch(toString(x), "(" = quote(zerocorr), "||" = quote(`|`)),
      how = "replace"
    )
  }
  x
}