diff --git a/R/lav_syntax_parser.R b/R/lav_syntax_parser.R index 7d8fe3a8..a7b30a0a 100644 --- a/R/lav_syntax_parser.R +++ b/R/lav_syntax_parser.R @@ -903,6 +903,15 @@ ldw_parse_model_string <- function(model.syntax = "", as.data.frame. = FALSE) { footer = tl[2L] ) } + # check for variable regressed on itself + if (formul1$elem.text[opi] == "~" && formul1$elem.text[opi - 1L] == formul1$elem.text[nelem]) { + tl <- ldw_txtloc(modelsrc, formul1$elem.pos[opi]) + lav_msg_stop( + gettext("a variable cannot be regressed on itself"), + tl[1L], + footer = tl[2L] + ) + } # checks for valid names in lhs and rhs ldw_parse_check_valid_name(formul1, opi - 1L, modelsrc) # valid name lhs for (j in seq.int(opi + 1L, nelem)) { # valid names rhs diff --git a/R/lav_syntax_parser_cr.R b/R/lav_syntax_parser_cr.R index feeedb99..502b97f2 100644 --- a/R/lav_syntax_parser_cr.R +++ b/R/lav_syntax_parser_cr.R @@ -63,7 +63,7 @@ ldw_parse_model_string_cr <- function(model.syntax = "", tl[1L], footer = tl[2L] ) - } else if (flat[1L] == 34L) { # SPE_INVALIDNAME + } else if (flat[1L] == 34L) { # SPE_AUTOREGRESS lav_msg_stop(gettext("a variable cannot be regressed on itself"), tl[1L], footer = tl[2L] diff --git a/R/lav_syntax_parser_r.R b/R/lav_syntax_parser_r.R index c5d23406..43c6fd8a 100644 --- a/R/lav_syntax_parser_r.R +++ b/R/lav_syntax_parser_r.R @@ -797,6 +797,9 @@ lav_parse_model_string_r <- function(model.syntax = "", as.data.frame. = FALSE) if (length(contsp) > 0L) { lav_local_msgcode(FALSE, 102L, formul1$elem.pos[contsp[1L]], msgenv) } + # check for variable regressed on itself + if (formul1$elem.text[opi] == "~" && formul1$elem.text[opi - 1L] == formul1$elem.text[nelem]) + return(c(34L, formul1$elem.pos[opi] - 1L)) # checks for valid names in lhs and rhs lav_parse_check_valid_name(formul1, opi - 1L, modelsrc, msgenv) # valid name lhs if (exists("error", envir = msgenv)) return(msgenv$error); @@ -891,14 +894,14 @@ lav_parse_model_string_r <- function(model.syntax = "", as.data.frame. = FALSE) if (opi > 2 && rmei == 1L) { lhsmod <- lav_parse_get_modifier( formul1, - TRUE, opi, modelsrc, types + TRUE, opi, modelsrc, types, 0L, 0L, msgenv ) } rhsmod <- list() if (nelem - opi > 1) { rhsmod <- lav_parse_get_modifier( formul1, - FALSE, opi, modelsrc, types, rme, rmeprev + FALSE, opi, modelsrc, types, rme, rmeprev, msgenv ) } flat.fixed[idx] <- if (is.null(rhsmod$fixed)) { diff --git a/R/ldw_trace.R b/R/ldw_trace.R index f0cde5ae..a0dab4fc 100644 --- a/R/ldw_trace.R +++ b/R/ldw_trace.R @@ -109,3 +109,18 @@ print_trace <- function(file = "", clean_after = (file != "")) { } if (clean_after) set_trace(NULL, TRUE) } + +summary_trace <- function(file = "", clean_after = FALSE) { + x <- get_trace() + temp <- new.env(parent = emptyenv()) + for (x1 in x) { + nn <- length(x1$stack) + mm <- paste(x1$stack[nn], paste(x1$stack[seq_len(nn - 1L)], collapse = ">"), sep = "\t") + assign(mm, 1L + get0(mm, temp, ifnotfound = 0L), temp) + } + objects <- sort(ls(temp)) + for (i in seq_along(objects)) { + cat(objects[i], get(objects[i], temp), "\n", file = file, append = TRUE) + } + if (clean_after) set_trace(NULL, TRUE) +} \ No newline at end of file