Table Generator

Learn how to contribute useful code to the table generator tab, by topic.

Create A Statistical Block

This tutorial will walk you through creating a new statistical block for the Table Generator using JavaScript and R, then writing an R function to use the block within the gt table.

Create the Drag Zone Block

Within R/mod_TableGen_ui you’ll find a list of blocks.

If you are going to create a simple block like in the case of MEAN, you’ll give the block an id in lowercase, and a label to be displayed in uppercase. You must also give the block class = agg

tags$li(id = "mean","MEAN",class = "agg")

If you want to create a more complicated block that changes within the drop zone, or has hover text there are a couple more arguments you must add:

tags$li(class = "ui-state-default agg", id = "chg",
        div(tippy(div("CHG"), "Change from Baseline")))

• an additional ui-state-default class
• another div using the package tippy to create the text to display CHG and the hover text

Create the Drop Zone Block

Under www/inst you will find the script.js file which describes the HTML for a block within the drag zone.

Currently there are two JavaScript functions to create HTML blocks

• simpleBlock which creates a block like the FREQ block which says “FREQ” when dragged and has a delete button

• selectWeekBlock which creates a dropdown when the block is dragged into the drop zone, determined by the unique values in the AVISIT column

You can add your block to the function $("#droppable_agg").droppable(... like so:

} else if (draggableId.includes("mean")) {
    $(this).append(selectWeekBlock(newid, "MEAN", select));
}

Where the lowecase mean corresponds to the ID of the block, and new_id is a JavaScript function that appends a number to your block ID in case there are multiple mean blocks inside the dropzone. The uppercase MEAN is what you want your block to display. Similarly you can change this code from selectWeekBlock to a simple block if you don’t need the week dropdown.

Writing the function

When you drag a column block, the shiny input returns the name of the column and the data file it came from. Using the custom_class function, the column name is given a class of BDS, ADSL, or OCCDS

We can leverage these classes when creating a new statistical function because we may want to perform slightly different calculations on an ADSL or BDS, for instance.

Let’s look at mod_tableGen_fct_freq as an example:

Create a function

app_freq <- function(column, week, group, data) {
  UseMethod("app_freq", column)
}


app_freq.default <- function(column, week, group, data) {
  rlang::abort(glue::glue(
    "Can't calculate mean because data is not classified as ADLB, BDS or OCCDS"
  ))
}

Create a method for ADSL

In the case of ADSL we need to calculate the frequency for the entire table, or if groups are selected and return a table of values to be used in gt.

app_freq.ADSL <- function(column, week, group = NULL, data) {
  
  column <- rlang::sym(as.character(column))
  
  if (!is.character(data[[column]])) {
    stop(paste("Can't calculate frequency, ", column, " is not categorical"))
  }
  
  if (is.null(group)) {
    data %>%
      distinct(USUBJID, !!column) %>%
      count(!!column) %>%
      group_by(!!column) %>%
      summarise(n = sum(n)) %>%
      ungroup() %>%
      mutate(prop = n/sum(n)) %>%
      mutate(x = paste0(n, " (", round(prop*100, 2), ")")) %>%
      select(!!column, x)
  } else {
    
    if (group == column) {
      stop(glue::glue("Cannot calculate frequency for {column} when also set as group."))
    }
    
    group <- rlang::sym(group)
    data %>%
      distinct(USUBJID, !!column, !!group) %>%
      count(!!column, !!group) %>%
      group_by(!!group) %>%
      mutate(prop = prop.table(n)) %>%
      mutate(v1 = paste0(n, ' (', round(prop*100, 2), ')')) %>%
      select(-n, -prop) %>% 
      spread(!!group, v1)
  }
}

Create a method for BDS

We don’t need a method for BDS because we currently only import PARAMCD blocks and since AVAL and CHG are numeric we can’t calculate frequency:

app_freq.BDS <- function(column, week, group = NULL, data) {
  rlang::abort(glue::glue(
    "Can't calculate frequency for BDS - {column} is numeric"
  ))
}

Feel free to explore the mean, ANOVA, and chg files for other statistical examples. For instance, blocks with BDS methods use the week argument which is supplied from the block’s dropdown.

Putting it all together

Once you have your statistical function, you need to add it to the app_methods function:

app_methods <- function(agg, column, week, group, data) {
  if (agg == "MEAN") {
    app_mean(column, week, group, data)
  } else if (agg == "FREQ") {
    app_freq(column, week, group, data)
  } else if (agg == "ANOVA") {
    app_anova(column, week, group, data)
  } else {
    app_chg(column, week, group, data)
  }
}

This function will look for the name of the dragged in statistical block and apply the correct statistical function based on the block’s name. Since the first argument of the function is the column to apply the statistical block on, it will look for the data file the column came from and choose the correct method.

Finally this function is used within a map in mod_tableGen so each statistical block is applied to each column in the drop zone iteratively.