R/addval.R

Defines functions addval

addval <- function(simfun, dat = list(), points = NULL,
    each = 1, minrun = FALSE, autosave_dir = NULL) {

    xvalues <- sapply(dat, function(y) digest::digest(as.numeric(y$x)))

    for (i in seq_len(nrow(points))) {

        ind <- which(xvalues == digest::digest(as.numeric(points[i,
            ])))

        if (length(ind) == 0) {
            ind <- length(dat) + 1
            dat[[ind]] <- list()
            dat[[ind]]$x <- points[i, ]
            resx <- c()
        } else {
            resx <- dat[[ind]]$y
        }
        a <- as.numeric(points[i, ])

        resx <- c(resx, replicate(each, suppressWarnings(suppressMessages(hush(simfun(as.numeric(points[i,
            ])))))))

        while (minrun && length(resx) > 1 && stats::var(resx) ==
            0) {
            resx <- c(resx, replicate(1, suppressWarnings(suppressMessages(hush(simfun(as.numeric(points[i,
                ])))))))
        }
        dat[[ind]]$y <- resx
    }

    if (!is.null(autosave_dir))
        save(dat, file = paste0(autosave_dir, "dat_autosave.RData"))

    return(dat)

}

Try the mlpwr package in your browser

Any scripts or data that you put into this service are public.

mlpwr documentation built on Oct. 4, 2024, 1:07 a.m.