Skip to content

Commit

Permalink
fix factors bug, fix NA in factors bug
Browse files Browse the repository at this point in the history
  • Loading branch information
@juliuspfadt
juliuspfadt committed Nov 27, 2023
1 parent 96c35bf commit 84be0f0
Show file tree
Hide file tree
Showing 4 changed files with 61 additions and 62 deletions.
6 changes: 3 additions & 3 deletions R/common.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -60,8 +60,8 @@ lavBootstrap <- function(fit, samples = 1000) {
ggmisfit$labels <- substr(round(ggmisfit$value, 2), 2, 4)
ggmisfit$labels[ggmisfit$labels == ""] <- "0"

levels(ggmisfit$Var1) <- .unv(levels(ggmisfit$Var1))
levels(ggmisfit$Var2) <- .unv(levels(ggmisfit$Var2))
levels(ggmisfit$Var1) <- levels(ggmisfit$Var1)
levels(ggmisfit$Var2) <- levels(ggmisfit$Var2)

misfitplot <-
ggplot2::ggplot(ggmisfit, ggplot2::aes(x = Var1, y = Var2, fill = value,
Expand Down Expand Up @@ -99,7 +99,7 @@ lavBootstrap <- function(fit, samples = 1000) {
if (length(encodedVars) == 0 || !is.character(encodedVars) || !is.character(message))
return(message)

decodedVars <- .unv(encodedVars)
decodedVars <- encodedVars
names(decodedVars) <- encodedVars
stringr::str_replace_all(message, decodedVars)
}
Expand Down
47 changes: 23 additions & 24 deletions R/lgcm.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,7 @@
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
#


LatentGrowthCurveInternal <- function(jaspResults, dataset, options, ...) {
ready <- length(options[["variables"]]) > 2
Expand Down Expand Up @@ -51,13 +51,9 @@ LatentGrowthCurveInternal <- function(jaspResults, dataset, options, ...) {
.lgcmPreprocessOptions <- function(dataset, options) {
# add dummy names
if (length(options[["categorical"]]) > 0) {
frml <- as.formula(paste("~", paste(.v(options[["categorical"]]), collapse = "+")))
frml <- as.formula(paste("~", paste(options[["categorical"]], collapse = "+")))
dumnames <- colnames(model.matrix(frml, dataset))[-1]
options[["dummy_names"]] <- stringr::str_replace_all(
string = dumnames,
pattern = .v(options[["categorical"]]),
replacement = options[["categorical"]]
)
options[["dummy_names"]] <- dumnames
}
return(options)
}
Expand All @@ -75,9 +71,12 @@ LatentGrowthCurveInternal <- function(jaspResults, dataset, options, ...) {
.lgcmEnrichData <- function(dataset, options) {
# Add dummies
if (length(options[["categorical"]]) > 0) {
frml <- as.formula(paste("~", paste(.v(options[["categorical"]]), collapse = "+")))
frml <- as.formula(paste("~", paste(options[["categorical"]], collapse = "+")))
# not error when the categorical variable has NAs:
options(na.action = "na.pass")
mm <- model.matrix(frml, dataset)[,-1, drop = FALSE]
colnames(mm) <- .v(options[["dummy_names"]])
options(na.action = currentNa)
colnames(mm) <- options[["dummy_names"]]
dataset <- cbind(dataset, mm)

}
Expand Down Expand Up @@ -151,16 +150,16 @@ LatentGrowthCurveInternal <- function(jaspResults, dataset, options, ...) {

# Basic LGCM curve information
Int <- if (options[["intercept"]])
paste("I =~", paste0("1*", .v(options[["variables"]]), collapse = " + "))
paste("I =~", paste0("1*", options[["variables"]], collapse = " + "))
else NULL
Lin <- if (options[["linear"]])
paste("\nL =~", paste0(timings, "*", .v(options[["variables"]]), collapse = " + "))
paste("\nL =~", paste0(timings, "*", options[["variables"]], collapse = " + "))
else NULL
Qua <- if (options[["quadratic"]])
paste("\nQ =~", paste0(timings^2, "*", .v(options[["variables"]]), collapse = " + "))
paste("\nQ =~", paste0(timings^2, "*", options[["variables"]], collapse = " + "))
else NULL
Cub <- if (options[["cubic"]])
paste("\nC =~", paste0(timings^3, "*", .v(options[["variables"]]), collapse = " + "))
paste("\nC =~", paste0(timings^3, "*", options[["variables"]], collapse = " + "))
else NULL
LGC <- paste0("\n# Growth curve\n", Int, Lin, Qua, Cub)

Expand All @@ -179,13 +178,13 @@ LatentGrowthCurveInternal <- function(jaspResults, dataset, options, ...) {
# Add regressions
Reg <- if (length(options[["regressions"]]) > 0)
paste0("\n\n# Regressions\n", paste(curve, collapse = " + "), " ~ ",
paste(.v(options[["regressions"]]), collapse = " + "))
paste(options[["regressions"]], collapse = " + "))
else NULL

# Add dummy variables
Dum <- if (length(options[["dummy_names"]]) > 0)
paste0("\n\n# Dummy-coded categorical predictors\n", paste(curve, collapse = " + "), " ~ ",
paste(.v(options[["dummy_names"]]), collapse = " + "))
paste(options[["dummy_names"]], collapse = " + "))

# Add time-varying covariates
# eww this is hard
Expand Down Expand Up @@ -407,7 +406,7 @@ LatentGrowthCurveInternal <- function(jaspResults, dataset, options, ...) {
pereg <- pe[pe$lhs %in% slope_names & pe$op == "~",]
pereg <- pereg[order(pereg$lhs), ]
latreg[["component"]] <- pereg[["lhs"]]
latreg[["predictor"]] <- .unv(pereg[["rhs"]])
latreg[["predictor"]] <- pereg[["rhs"]]
latreg[["est"]] <- pereg[["est"]]
latreg[["se" ]] <- pereg[["se"]]
latreg[["zval"]] <- pereg[["z"]]
Expand All @@ -422,8 +421,8 @@ LatentGrowthCurveInternal <- function(jaspResults, dataset, options, ...) {
}

# residual variances
perev <- pe[pe$lhs %in% .v(options[["variables"]]) & pe$lhs == pe$rhs,]
resvar[["var"]] <- .unv(perev[["lhs"]])
perev <- pe[pe$lhs %in% options[["variables"]] & pe$lhs == pe$rhs,]
resvar[["var"]] <- perev[["lhs"]]
resvar[["est"]] <- perev[["est"]]
resvar[["se"]] <- perev[["se"]]
resvar[["zval"]] <- perev[["z"]]
Expand Down Expand Up @@ -532,7 +531,7 @@ LatentGrowthCurveInternal <- function(jaspResults, dataset, options, ...) {
# get r2 of variables, excluding the latent variables.
r2res <- lavaan::inspect(modelContainer[["model"]][["object"]], "r2")
r2res <- r2res[!names(r2res) %in% c("I", "L", "Q", "C")]
varnames <- .unv(names(r2res))
varnames <- names(r2res)
tabr2[["__var__"]] <- varnames
tabr2[["rsq"]] <- r2res
}
Expand All @@ -553,7 +552,7 @@ LatentGrowthCurveInternal <- function(jaspResults, dataset, options, ...) {

for (i in 1:ncol(ic)) {
nm <- colnames(ic)[i]
tab$addColumnInfo(nm, title = .unv(nm), type = "number", format = "sf:4;dp:3")
tab$addColumnInfo(nm, title = nm, type = "number", format = "sf:4;dp:3")
}
tab$addRows(ic, rowNames = colnames(ic))

Expand All @@ -576,7 +575,7 @@ LatentGrowthCurveInternal <- function(jaspResults, dataset, options, ...) {

for (i in 1:ncol(rc)) {
nm <- colnames(rc)[i]
tab$addColumnInfo(nm, title = .unv(nm), type = "number", format = "sf:4;dp:3")
tab$addColumnInfo(nm, title = nm, type = "number", format = "sf:4;dp:3")
}
tab$addRows(rc, rowNames = colnames(rc))

Expand Down Expand Up @@ -616,17 +615,17 @@ LatentGrowthCurveInternal <- function(jaspResults, dataset, options, ...) {
df_long <- tidyr::gather(df_wide, key = "Participant", value = "Val", -"xx")

if (ctgcl)
df_long[[options[["curvePlotCategorical"]]]] <- rep(dataset[[.v(options[["curvePlotCategorical"]])]][idx], each = 1000)
df_long[[options[["curvePlotCategorical"]]]] <- rep(dataset[[options[["curvePlotCategorical"]]]][idx], each = 1000)

# create raw data points data frame
points <- data.frame(lgcmResult@Data@X[[1]])[idx, lgcmResult@Data@ov.names[[1]] %in% .v(options[["variables"]])]
points <- data.frame(lgcmResult@Data@X[[1]])[idx, lgcmResult@Data@ov.names[[1]] %in% options[["variables"]]]
names(points) <- timings
points[["Participant"]] <- paste0("X", 1:nrow(points))
points_long <- tidyr::gather(points, key = "xx", value = "Val", -"Participant")
points_long[["xx"]] <- as.numeric(points_long[["xx"]])

if (ctgcl)
points_long[[options[["curvePlotCategorical"]]]] <- rep(dataset[[.v(options[["curvePlotCategorical"]])]][idx],
points_long[[options[["curvePlotCategorical"]]]] <- rep(dataset[[options[["curvePlotCategorical"]]]][idx],
length(timings))

# points may need to be jittered
Expand Down
16 changes: 8 additions & 8 deletions R/mimic.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -57,7 +57,7 @@ MIMICInternal <- function(jaspResults, dataset, options, ...) {
customChecks <- list(
checkExogenous = function() {
admissible <- vapply(exo, function(exo_var) {
var <- na.omit(dataset[[.v(exo_var)]])
var <- na.omit(dataset[[exo_var]])
if (is.ordered(var)) return(FALSE)
if ((is.character(var) || is.factor(var)) && length(unique(var)) != 2) return(FALSE)
return(TRUE)
Expand All @@ -69,7 +69,7 @@ MIMICInternal <- function(jaspResults, dataset, options, ...) {
checkEndogenous = function() {
if (length(options$confounds) > 0) endo <- c(endo, options$predictor)
admissible <- vapply(endo, function(endo_var) {
var <- na.omit(dataset[[.v(endo_var)]])
var <- na.omit(dataset[[endo_var]])
if (!(is.ordered(var) || is.numeric(var))) {
return(FALSE)
}
Expand All @@ -83,7 +83,7 @@ MIMICInternal <- function(jaspResults, dataset, options, ...) {
if (length(options$confounds) > 0) endo <- c(endo, options$predictor)

admissible <- vapply(endo, function(endo_var) {
var <- na.omit(dataset[[.v(endo_var)]])
var <- na.omit(dataset[[endo_var]])
if (is.ordered(var) && options$naAction == "fiml") {
return(FALSE)
}
Expand Down Expand Up @@ -149,15 +149,15 @@ MIMICInternal <- function(jaspResults, dataset, options, ...) {
" Y =~",
paste(
paste("lambda", seq_along(options[["indicators"]]), "*", sep = ""),
.v(options[["indicators"]]),
options[["indicators"]],
collapse = " + ", sep = ""
)
)
structural <- paste(
" Y ~ ",
paste(
paste("beta", seq_along(options[["predictors"]]), "*", sep = ""),
.v(options[["predictors"]]),
options[["predictors"]],
collapse = " + ", sep = ""
)
)
Expand Down Expand Up @@ -354,7 +354,7 @@ MIMICInternal <- function(jaspResults, dataset, options, ...) {
standardized = TRUE)

pe_bet <- pe[substr(pe$label, 1, 1) == "b", ]
bettab[["rhs"]] <- .unv(pe_bet$rhs)
bettab[["rhs"]] <- pe_bet$rhs
bettab[["est"]] <- pe_bet$est
bettab[["se"]] <- pe_bet$se
bettab[["z"]] <- pe_bet$z
Expand All @@ -369,7 +369,7 @@ MIMICInternal <- function(jaspResults, dataset, options, ...) {
}

pe_lam <- pe[substr(pe$label, 1, 1) == "l", ]
lamtab[["rhs"]] <- .unv(pe_lam$rhs)
lamtab[["rhs"]] <- pe_lam$rhs
lamtab[["est"]] <- pe_lam$est
lamtab[["se"]] <- pe_lam$se
lamtab[["z"]] <- pe_lam$z
Expand Down Expand Up @@ -398,7 +398,7 @@ MIMICInternal <- function(jaspResults, dataset, options, ...) {
if (!ready || modelContainer$getError()) return()

r2res <- lavaan::inspect(modelContainer[["model"]][["object"]], "r2")
tabr2[["__var__"]] <- .unv(names(r2res))
tabr2[["__var__"]] <- names(r2res)
tabr2[["rsq"]] <- r2res
}

Expand Down
Loading

0 comments on commit 84be0f0

Please sign in to comment.