Skip to content

Commit

Permalink
attempt to revert back
Browse files Browse the repository at this point in the history
  • Loading branch information
lebebr01 committed Mar 15, 2024
1 parent cfa0fa8 commit 581a9ab
Show file tree
Hide file tree
Showing 4 changed files with 6 additions and 71 deletions.
1 change: 0 additions & 1 deletion NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -17,7 +17,6 @@ export(parse_multiplemember)
export(parse_power)
export(parse_randomeffect)
export(parse_varyarguments)
export(parse_varyarguments_mf)
export(parse_varyarguments_w)
export(random_missing)
export(rbimod)
Expand Down
36 changes: 0 additions & 36 deletions R/parse_formula.r
Original file line number Diff line number Diff line change
Expand Up @@ -245,9 +245,6 @@ parse_varyarguments_w <- function(sim_args, name) {
names = name,
exclude = FALSE),
KEEP.OUT.ATTRS = FALSE)
# conditions <- list_select(sim_args[['vary_arguments']],
# names = name,
# exclude = FALSE)
if(any(sapply(conditions, is.list))) {
loc <- sapply(conditions, is.list)
simp_conditions <- conditions[loc != TRUE]
Expand All @@ -268,39 +265,6 @@ parse_varyarguments_w <- function(sim_args, name) {
}

}
#' Parse within varying arguments
#'
#' @param sim_args A named list with special model formula syntax. See details and examples
#' for more information. The named list may contain the following:
#' \itemize{
#' \item fixed: This is the fixed portion of the model (i.e. covariates)
#' \item random: This is the random portion of the model (i.e. random effects)
#' \item error: This is the error (i.e. residual term).
#' }
#' @param name The name of the within simulation condition. This is primarily
#' an internal function.
#'
#' @export
parse_varyarguments_mf <- function(sim_args, name) {

conditions <- list_select(sim_args[['vary_arguments']],
names = name,
exclude = FALSE)
if(any(sapply(conditions, is.list))) {
loc <- sapply(conditions, is.list)
list_conditions <- conditions[loc == TRUE]
update_conditions <- lapply(seq_along(conditions), function(xx) c(sim_args,
model_fit = list_conditions[xx]))
for(xx in seq_along(update_conditions)) {
names(update_conditions[[xx]]) <- gsub("\\..*", "", names(update_conditions[[xx]]))
}
} else {
lapply(1:nrow(conditions), function(xx) c(sim_args,
conditions[xx, , drop = FALSE]))
}

}


#' Parse correlation arguments
#'
Expand Down
17 changes: 6 additions & 11 deletions R/pow_sim.r
Original file line number Diff line number Diff line change
Expand Up @@ -145,25 +145,20 @@ replicate_simulation_vary <- function(sim_args, return_list = FALSE,
within_conditions <- list_select(sim_args[['vary_arguments']],
names = c('model_fit'),
exclude = FALSE, simplify = FALSE)
if(length(within_conditions) > 0 ) {
within_conditions_name <- names(
list_select(sim_args[['vary_arguments']],
names = c('model_fit'),
exclude = FALSE, simplify = TRUE)
)
}
between_conditions <- list_select(sim_args[['vary_arguments']],
names = c('model_fit', 'power'),
exclude = TRUE, simplify = FALSE)

between_conditions_name <- data.frame(sapply(expand.grid(between_conditions, KEEP.OUT.ATTRS = FALSE),
as.character))
within_conditions_name <- data.frame(sapply(expand.grid(within_conditions, KEEP.OUT.ATTRS = FALSE),
as.character))


sim_arguments <- parse_varyarguments(sim_args)

if(length(within_conditions) > 0) {
sim_arguments_w <- parse_varyarguments_mf(sim_args, name = c('model_fit'))
if(length(within_conditions_name) > 0) {
sim_arguments_w <- parse_varyarguments_w(sim_args, name = c('model_fit'))

if(any(unlist(lapply(seq_along(sim_arguments_w), function(xx)
sim_arguments_w[[xx]][['model_fit']] |> names())) == 'name')) {
Expand All @@ -190,7 +185,7 @@ replicate_simulation_vary <- function(sim_args, return_list = FALSE,
}, future.seed = future.seed)
}, future.seed = future.seed)
}
if(length(within_conditions) == 0) {
if(length(within_conditions_name) == 0) {

power_out <- future.apply::future_lapply(seq_along(sim_arguments), function(xx) {
future.apply::future_replicate(sim_arguments[[xx]][['replications']],
Expand All @@ -215,7 +210,7 @@ replicate_simulation_vary <- function(sim_args, return_list = FALSE,
rep(1:sim_args[['replications']],
each = num_rows[xx]/sim_args[['replications']]))

if(length(within_conditions) > 0) {
if(length(within_conditions_name) > 0) {
num_terms <- lapply(seq_along(power_out), function(xx)
lapply(seq_along(power_out[[xx]]), function(yy)
lapply(power_out[[xx]][[yy]], nrow))
Expand Down
23 changes: 0 additions & 23 deletions man/parse_varyarguments_mf.Rd

This file was deleted.

0 comments on commit 581a9ab

Please sign in to comment.