R/drug_tabler.R

In JayAchar/tbreportr: Tools for Reporting TB Data

#' Cohort drug frequency tables
#'
#' Generate frequency tables for TB cohort data from Koch 6 which has been cleaned,
#'  and subsetted into a drug-spectific data frame. 
#' @param x dataframe of combined and cleaned admission and change data from Koch 6
#' @param year numerical 4 digit value representing year of interest - optional
#' @param month numerical 2 digit value representing month of interest - optional
#' @return list containg both a 3x2 frequency table with total row - subsetted by year and month if defined, 
#' and a formatted version for display in Rmd files
#' @author Jay Achar 
#' @seealso \code{\link{tbreportr}}
#' @export
#' @importFrom dplyr filter count
#' @importFrom tidyr complete
#' @importFrom rlang enquo .data
#' @importFrom magrittr %>%
#' @importFrom lubridate month year
#' @importFrom kableExtra kable_styling column_spec
#' @importFrom knitr kable
#' @importFrom assertthat assert_that
#' @examples
#' x <- structure(list(id = 1:10, Starttre = structure(c(17211, 17634, 
#' 17738, 17683, 16899, 16598, 17201, 16587, 16587, 16601), class = "Date"), 
#' Age = structure(c(1L, 2L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L), 
#'                .Label = c("<= 18 years", 
#'                           ">18 years"), class = "factor")), 
#'                                         row.names = c(NA, -10L), 
#'                                         class = c("tbl_df", 
#'                                                   "tbl", "data.frame"))
#' drug_tabler(x)
#' drug_tabler(x, year = 2018)
#' drug_tabler(x, year = 2015, month = 06)

drug_tabler <- function(x, year = NULL, month = NULL) {
## checks ##
# check x input
    assert_that(is.data.frame(x))
    assert_that(all(c("id", "Age", "Starttre") %in% names(x)))
    assert_that(class(x$Age) == "factor")
    assert_that(class(x$Starttre) == "Date")
        
# check input args are numbers
        if (! is.null(year)) {
            assert_that(is.numeric(year))
            assert_that(year > 0)
            assert_that(year %% 1 == 0)  # check year arg is whole number

        }
        if (! is.null(month)) {
            assert_that(is.numeric(month))
            assert_that(month > 0)
            assert_that(month %% 1 == 0)  # check month arg is whole number
            assert_that(month %in% 1:12)
            
        }
        
# check `year` is defined when `month` is included as an arg
        if (! is.null(month) & is.null(year)) {
                stop("`year` arg must be defined if `month` arg defined")           
        }

        
## ==============================================        
# convert `year` into quosure
        if (! is.null(year))  year_en <- enquo(year)        

# convert `month` into quosure
        if (! is.null(month))  month_en <- enquo(month)
        
        
# filter by year
  if (! is.null(year) & is.null(month)) {
          x <- x %>% 
                  filter(year(.data$Starttre) == !! year)
  } else if (! is.null(year) & ! is.null(month)){
          x <- x %>% 
                  filter(year(.data$Starttre) == !! year) %>% 
                  filter(month(.data$Starttre) == !! month)
  }

# count by age category - ensure empty categories are represented
  x <- x %>% 
    count(.data$Age) %>%
    complete(Age, fill = list(n = 0))
  
# add total row at bottom of table
 total_row <- c("Total", sum(x[, 2], na.rm = T))
 x$Age <- as.character(x$Age)
 x <- rbind(x, total_row) 
  
 
# format table
formatted_table <- kable(x) %>%
         kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"), 
                       full_width = F, position = "left") %>%
         column_spec(1, width = "15em") %>%
         column_spec(2, width = "10em") 
 
# output list of both basic frequency table for subsetting and formatted table for display
output <- list(freq_table = x,
               display_table = formatted_table)
output
}