Testing interactive input of study design

interactive_test

#devtools::install_github("debruine/faux")
library(faux)

# make unique pairs of level names to ask for cors
unique_pairs <- function(v) {
  if (is.numeric(v)) { v <- LETTERS[1:v] }
  
  expand.grid(a = v, b = v) %>% 
    filter(a != b) %>% t() %>% 
    tibble::as_tibble() %>% 
    dplyr::mutate_all(sort) %>% t() %>%
    tibble::as_tibble() %>% 
    tidyr::unite(combo, 1:2) %>%
    dplyr::distinct(combo) %>%
    pull(combo)
}


inter_test <- function() {
  wn <- readline(prompt="How many within-subject factors do you have?: ")
  within <- list()
  cors <- list()
  if (wn > 0) {
    for (i in 1:wn) {
      p <- paste0("Name of within-subject factor ", i, ": ")
      name <- readline(prompt=p)
      
      p <- paste0("How many levels of ", name, ": ")
      nlevels <- readline(prompt=p) %>% as.integer()
      
      levels <- c()
      for (j in 1:nlevels) {
        p <- paste0("Name of factor ", name, ", level ", j, ": ")
        levels[j] <- readline(prompt=p)
      }
      
      up <- unique_pairs(levels)
      r <- purrr::map_dbl(up, function(x) {
        p <- paste0("Correlation for ", x, ": ")
        readline(prompt=p) %>% as.double()
      })
      
      if (!is_pos_def(cormat_from_triangle(r))) {
        warning("That correlation matrix is not possible")
      }
      
      within[[name]] <- levels
      cors [[name]] <- r
    }
  }
  
  bn <- readline(prompt="How many between-subject factors do you have?: ")
  between <- list()
  if (bn > 0) {
    for (i in 1:bn) {
      p <- paste0("Name of between-subject factor ", i, ": ")
      name <- readline(prompt=p)
      
      p <- paste0("How many levels of ", name, ": ")
      nlevels <- readline(prompt=p) %>% as.integer()
      
      levels <- c()
      for (j in 1:nlevels) {
        p <- paste0("Name of factor ", name, ", level ", j, ": ")
        levels[j] <- readline(prompt=p)
      }
      between[[name]] <- levels
    }
  }
  
  within <- purrr::map(within, faux:::fix_name_labels)
  between <- purrr::map(between, faux:::fix_name_labels)
  
  cells_w <- faux:::cell_combos(within)
  cells_b <- faux:::cell_combos(between) 
  
  g <- expand.grid(w = cells_w, b = cells_b)
  mu <- purrr::map2(g$w, g$b, function(w, b) {
    p <- paste0("Mean of within-subject cell ", w, " in between-subject condition ", b, " : ")
    readline(prompt=p)
  }) %>% matrix(nrow = length(cells_w), dimnames = list(cells_w, cells_b)) %>%
    as.data.frame()
  
  sd <- purrr::map2(g$w, g$b, function(w, b) {
    p <- paste0("SD of within-subject cell ", w, " in between-subject condition ", b, " : ")
    readline(prompt=p)
  }) %>% matrix(nrow = length(cells_w), dimnames = list(cells_w, cells_b)) %>%
    as.data.frame()
  
  n <- readline(prompt="Sample size per cell: ") %>% as.integer()
  
  list(
    within = within,
    between = between,
    cells_w = cells_w,
    cells_b = cells_b,
    n = n,
    mu = mu,
    sd = sd,
    r = cors
  )
}