R/add_newrows.R

In tidytlg: Create TLGs using the 'tidyverse'

#' Add the newrows variable to the results dataframe.
#'
#' The newrows variable is used by `gentlg()` to define when to add a blank row
#' to the output. Data will be grouped by anbr and the variables passed into
#' the tableby and groupby parameters.`newrows` will be set to 1 for the first
#' record in each group, except for the first row in the data.
#' The first row will always be set to 0.
#'
#' @param df dataframe of results.  must contain the anbr variable that is
#' added by add_format()
#' @param tableby character vector containing table by variables used to
#' generate the results
#' @param groupby character vector containing group by variables used to
#' generate the results
#'
#' @return dataframe with the variable newrows and roworder added.
#' newrows is used by gentlg to insert line breaks.
#' @export
#'
#' @examples
#' # Example showing how newrows is set to one for each new anbr except
#' # the first
#' tbl <-
#'   structure(
#'     list(
#'       rowvar = c("RANDFL", "AGE", "AGE", "AGE", "AGE", "AGE"),
#'       anbr = c(1L, 2L, 2L, 2L, 2L, 2L),
#'       label = c(
#'         "Analysis set: Subjects Randomized", "Age (Years)", "N",
#'         "Mean (SD)", "Range", "IQ Range"
#'       ),
#'       row_type = c("COUNT", "UNIVAR", "UNIVAR", "UNIVAR", "UNIVAR", "UNIVAR")
#'     ),
#'     row.names = c(NA, -6L),
#'     class = c("tbl_df", "tbl", "data.frame")
#'   )
#'
#' add_newrows(tbl)
#'
#' # Example of use when you have results summarized by one or more variables
#' tbl2 <- tibble::tribble(
#'   ~anbr, ~SEX, ~label, ~row_type,
#'   "01", "F", "Sex : F", "TABLE_BY_HEADER",
#'   "01", "F", "<65", "VALUE",
#'   "01", "F", "65-80", "VALUE",
#'   "01", "F", ">80", "VALUE",
#'   "01", "M", "Sex : M", "TABLE_BY_HEADER",
#'   "01", "M", "<65", "VALUE",
#'   "01", "M", "65-80", "VALUE",
#'   "01", "M", ">80", "VALUE"
#' )
#'
#' add_newrows(tbl2, tableby = "SEX")
#'
#' tbl3 <- tibble::tribble(
#'   ~anbr, ~SEX, ~ETHNIC, ~label, ~row_type,
#'   "01", "F", NA, "Sex : F", "TABLE_BY_HEADER",
#'   "01", "F", "HISPANIC OR LATINO", "HISPANIC OR LATINO", "BY_HEADER1",
#'   "01", "F", "HISPANIC OR LATINO", "<65", "VALUE",
#'   "01", "F", "HISPANIC OR LATINO", ">80", "VALUE",
#'   "01", "F", "HISPANIC OR LATINO", "65-80", "VALUE",
#'   "01", "F", "NOT HISPANIC OR LATINO", "NOT HISPANIC OR LATINO", "BY_HEADER1",
#'   "01", "F", "NOT HISPANIC OR LATINO", "<65", "VALUE",
#'   "01", "F", "NOT HISPANIC OR LATINO", "65-80", "VALUE",
#'   "01", "F", "NOT HISPANIC OR LATINO", ">80", "VALUE",
#'   "01", "M", NA, "Sex : M", "TABLE_BY_HEADER",
#'   "01", "M", "HISPANIC OR LATINO", "HISPANIC OR LATINO", "BY_HEADER1",
#'   "01", "M", "HISPANIC OR LATINO", "<65", "VALUE",
#'   "01", "M", "HISPANIC OR LATINO", "65-80", "VALUE",
#'   "01", "M", "HISPANIC OR LATINO", ">80", "VALUE",
#'   "01", "M", "NOT HISPANIC OR LATINO", "NOT HISPANIC OR LATINO", "BY_HEADER1",
#'   "01", "M", "NOT HISPANIC OR LATINO", "<65", "VALUE",
#'   "01", "M", "NOT HISPANIC OR LATINO", "65-80", "VALUE",
#'   "01", "M", "NOT HISPANIC OR LATINO", ">80", "VALUE"
#' )
#'
#' add_newrows(tbl3, tableby = "SEX", groupby = "ETHNIC")
add_newrows <- function(df, tableby = NULL, groupby = NULL) {
  dfn <- df %>%
    dplyr::group_by_at(c(tableby, groupby, "anbr")) %>%
    dplyr::mutate(
      roworder = dplyr::row_number(),
      newrows =
        dplyr::case_when(
          .data$roworder == 1 ~ 1,
          row_type == "TABLE_BY_HEADER" ~ 1,
          TRUE ~ 0
        )
    ) %>%
    dplyr::ungroup() %>%
    dplyr::mutate(
      newrows = ifelse(dplyr::row_number() == 1, 0, .data$newrows),
      newrows = ifelse(lag(newrows, na = 0) == 1 &
        row_type == "BY_HEADER2", 0, newrows)
    )

  if ("nested_level" %in% names(dfn)) {
    dfn %>%
      dplyr::mutate(newrows = case_when(
        row_type == "NESTED" &
          nested_level == 0 ~ 1,
        TRUE ~ newrows
      ))
  } else {
    dfn
  }
}