R/ANOPA-random.R

In ANOPA: Analyses of Proportions using Anscombe Transform

######################################################################################
#' @name GRP
#'
#' @title Generating random proportions with GRP
#'
#' @aliases GRP rBernoulli gSwitch
#'
#' @md
#'
#' @description The function `GRP()` 
#'      generates random proportions based on a design, i.e.,
#'      a list giving the factors and the categories with each factor.
#'      The data are returned in the 'wide' format.
#'
#' @usage GRP( props, n, BSDesign=NULL, WSDesign=NULL, sname = "s" )
#' @usage rBernoulli(n, p)
#'
#' @param BSDesign  A list with the between-subject factor(s) and the categories within each;
#' @param WSDesign  A list with the within-subject factor(s) and the categories within each;
#' @param props      (optional) the proportion of succes in each cell of the design. Default 0.50;
#' @param sname     (optional) the column name that will contain the success/failure;
#' @param n         How many simulated participants are in each between-subject group (can be a vector, one per group);
#' @param p         a proportion of success;
#'
#' @return `GRP()` returns a data frame containing success (coded as 1) or failure (coded as 0)
#'     for n participants per cells of the design. Note that correlated
#'     scores cannot be generated by `GRP()`; see \insertCite{ld98}{ANOPA}.
#' `rBernoulli()` returns a sequence of n success (1) or failures (0)
#'
#' @details The name of the function `GRP()` is derived from `GRD()`,
#'    a general-purpose tool to generate random data \insertCite{ch19}{ANOPA} 
#'    now bundled in the `superb` package \insertCite{cgh21}{ANOPA}. 
#'    `GRP()` is actually a proxy for `GRD()`.
#'
#' @references
#' \insertAllCited{}
#'
#' @examples
#' 
#' # The first example generate scorse for 20 particants in one factor having
#' # two categories (low and high):
#' design <- list( A=c("low","high"))
#' GRP( design, props = c(0.1,  0.9), n = 20 )
#' 
#' # This example has two factors, with factor A having levels a, b, c
#' # and factor B having 2 levels, for a total of 6 conditions;
#' # with 40 participants per group, it represents 240 observations:
#' design <- list( A=letters[1:3], B = c("low","high"))
#' GRP( design, props = c(0.1, 0.15, 0.20, 0.80, 0.85, 0.90), n = 40 )
#' 
#' # groups can be unequal:
#' design <- list( A=c("low","high"))
#' GRP( design, props = c(0.1,  0.9), n = c(5, 35) )
#'
#' # Finally, repeated-measures can be generated
#' # but note that correlated scores cannot be generated with `GRP()`
#' wsDesign = list( Moment = c("pre", "post") )
#' GRP( WSDesign=wsDesign, props = c(0.1,  0.9), n = 10 )
#'
#' # This last one has three factors, for a total of 3 x 2 x 2 = 12 cells
#' design <- list( A=letters[1:3], B = c("low","high"), C = c("cat","dog"))
#' GRP( design, n = 30, props = rep(0.5,12) )
#' 
#' # To specify unequal probabilities, use
#' design  <- list( A=letters[1:3], B = c("low","high"))
#' expProp <- c(.05, .05, .35, .35, .10, .10 )
#' GRP( design, n = 30, props=expProp )
#' 
#' # The name of the column containing the proportions can be changed
#' GRP( design, n=30, props=expProp, sname="patate")
#'
#' # Examples of use of rBernoulli
#' t <- rBernoulli(50, 0.1)
#' mean(t)
#'
#'
#'
######################################################################################
#' 
#' @importFrom superb GRD 
#' @importFrom stats runif
#' @export GRP
#' @export rBernoulli
#
######################################################################################


# a Bernoulli random success/failure generator
rBernoulli <- function(n, p = 0.5) {
    (stats::runif(n) < p) + 0 #converts to numeric
}


# `gSwitch()` is a generalized form of switch which can switch based on 
#     an exact match with scalars or with vectors.
# @param .default    default expression if none of the formulas in ... applies
# # Examples of use of gSwitch with a scalar (first) and a 2-dim vector (second)
# gSwitch( 12, 10~"a", 11~"b", 12~"c")
# gSwitch( c(1,2), c(1,1)~ 11, c(1,2) ~ 12, c(1,3) ~ 13)
# # they return "c" and 12 respectively
#
# # when the right-hand side of equation is an expression, it is evaluated:
# v <- "toto"
# w <- 4
# gSwitch( c(v,w), 
#    c("toto",4) ~ paste(v,w,sep="<>"), 
#    c("bibi",9) ~ paste(v,w,sep="><") 
# )
#
# Same as switch except that the expression can be a vector 
# rather than singletons. In that case the whole vector must
# match one of the proposed alternative or else .default is returned.
# The alternatives are given as formulas of the form: toMatch ~ replacement:
gSwitch <- function(EXPR, ..., .default = -99 ){
    alt <- list(...)
    if (!(all(sapply(alt, is.formula))))
        stop("ANOPA::GRP: not all alternatives are formulas. Exiting...")
    if (any(sapply(alt, is.one.sided)))
        stop("ANOPA::GRP: not all alternatives are two-sided ~. Exiting...")
    res <- sapply(alt, \(x) identical(eval(x[[2]]), EXPR ) )
    pos <- which( TRUE == res )
    if (length(pos) == 0) 
        return (eval(.default))
    else
        return(eval(alt[[pos]][[3]]))
}


# the main function here: Generating Random Proportions
# (or more precisely, of success or failure, coded as 1 or 0 resp.)
GRP <- function( 
        props,            # proportions of success in the population
        n,                # sample size.
        BSDesign = NULL,  # a list of factors with each a vector of levels
        WSDesign = NULL,  # idem
        sname    = "s"    # name of the column containing the results 0|1
    ) {

    # 1- Validation of input
    if (is.null(n))
        stop("ANOPA::GRP (1002): The sample size n is not provided. Exiting...")
    if (is.null(BSDesign)&&is.null(WSDesign)) 
        stop("ANOPA::GRP (1003): Both within subject and between subject factors are null. Provide at least one factor. Exiting...")

    # if messages are inhibited, inhibit them in superb as well
    if ("none" %in% getOption("ANOPA.feedback") ) {
        old <- options() 
        on.exit(options(old)) 
        options("superb.feedback" = "none")
    }
    
    # preparing the input to match GRD format
    BSDasText <- mapply(\(x,y) {paste(x,"(",paste(y,collapse=","),")",sep="")}, 
            names(BSDesign), 
            BSDesign )
    WSDasText<- mapply(\(x,y) {paste(x,"(",paste(y,collapse=","),")",sep="")}, 
            names(WSDesign), 
            WSDesign )
    wholeDesign <- c(BSDesign, WSDesign)

    ## 2- Expanding the design into cells
    levels <- sapply(wholeDesign, length, simplify = TRUE)
    nlevels <- prod(levels)
    if (length(props)!=nlevels)
       stop("ANOPA::GRP (1001): The number of proportions given does not match the number of cells in the design. Exiting...")
    res <- expand.grid(wholeDesign)

    # 3- Assemble a gSwitch expression
    fct <- function(line) {
        paste("    c('",paste(line[(1:length(line)-1)], collapse="','"),
                      "') ~ ", line[length(line)], sep="")
    }
    lines <- apply(as.matrix(cbind(res, props)), 1, fct) 
    gswit <- paste("ANOPA:::gSwitch( c(",paste(names(res), collapse=","), "), \n", 
                    paste(lines, collapse=",\n"), ",\n    .default = -99\n)", sep="")

    # 4- All done! send this to GRD
    superb::GRD( SubjectsPerGroup= n,
        BSFactors  = BSDasText,
        WSFactors  = WSDasText,
        RenameDV   = sname,
        Population = list(
            scores = paste("rBernoulli(1, p=",gswit,")")
        )
    )
}