inst/apps/GUI/global.R

In MayaGans/TableGenerator: Drag and Drop Elements in 'Shiny' using 'Dragula Javascript Library'

library(tidyverse)

CapStr <- function(y) {
  c <- strsplit(y, " ")[[1]]
  paste(toupper(substring(c, 1,1)), substring(c, 2),
        sep="", collapse=" ")
}

dummy <- data.frame(age = c(20,30,50,60,70,90,40,20,40,30),
                    sex = c(rep("male", 5), rep("female", 5)),
                    ethnicity  = c("Hispanic or Latino", "Not Hispanic or Latino", "Hispanic or Latino", "Hispanic or Latino", "Hispanic or Latino",
                                   "Not Hispanic or Latino","Not Hispanic or Latino","Hispanic or Latino", "Hispanic or Latino", "Hispanic or Latino"),
                    treatment = c(rep("control", 5), rep("treatment", 5)),
                    dose = c(seq(1:5), seq(1:5)))

total <- dummy %>% summarise(n = n())

# turn table generator into a function

ROW_FUNCTION <- function(row) {
  if (row == "age") {
    row_df <- data.frame(Variable = "Age", Total = "")
    colnames(row_df) <- c("Variable", paste0("Total N = (", total, ")"))
    row_df <- row_df
  } else {
    row_df <- data.frame(Variable = "Ethnicity", Total = "")
    colnames(row_df) <- c("Variable", paste0("Total N = (", total, ")"))
    row_df <- row_df
  }
}

AGG_STRING <- function(agg, row) {
  if (agg == "mean/sd") {
    string <- paste("summarise(mean = mean(", row, "), sd = sd(", row, ")))")
  } else {
    string <- paste("summarise(mean = mean(", row, "), sd = sd(", row, ")))")
  }
}

AGG_FUNCTION <- function(agg, row) {
  if (agg == "mean/sd") {
    string <- paste("t(dummy %>%
                    summarise(mean = mean(", row, "),
                    sd = sd(", row, ")))")

    test <- eval(parse(text=string))
    d <- test
    names <- rownames(d)
    rownames(d) <- NULL
    data <- cbind(names,d)
    colnames(data) <- c("Variable", paste0("Total N = (", total, ")"))
    row_df <- rbind(ROW_FUNCTION(row), data)
  } else {
    string <- paste("dummy %>% group_by(", row, ") %>% summarise(N = n())")
    test <- eval(parse(text=string))
    colnames(test) <- unlist(lapply(colnames(test), CapStr))
    test
  }
}


TITLE_ROW <- function(row) {
  insert <- data.frame("X" = row)
  return(insert)
}


COLUMN_FUNCTION <- function(agg, col, row) {

  if (agg == "mean/sd") {
    string <- paste("t(dummy %>% group_by(", col, ") %>%
                      summarise(N = n(),
                      mean = mean(", row, "),
                      sd = sd(", row, ")))")

    test <- eval(parse(text=string))

    d <- test
    names <- rownames(d)
    rownames(d) <- NULL
    data <- data.frame(cbind(names,d))
    rnames <- c("X", d[1,])
    names(data) <- unlist(lapply(rnames, CapStr))
    data <- data %>% slice(-1)

    insert <- data.frame("X" = CapStr(row))
    data <- bind_rows(insert, data)
  } else {
    string <- paste0("dummy %>% group_by(", row, ",", col, ") %>% summarise(N = n())")
    test <- eval(parse(text=string))
    insert <- data.frame("X" = CapStr(row))
    data <- bind_rows(insert, test)
    data <- data.frame(X = na.omit(unique(data$ethnicity)),
                       "Control" = c("4 (1)", "3 (2)"),
                       "Treatment" = c("3 (2)", "2 (3)"))
    data <- bind_rows(insert, data)
  }
}