R/clsales_parser.R

#' @title clsales_parser
#'
#' @description A function to parse sales data from
#' L:\\Rochester-Quality Regulatory Compliance\\SRMS\\SRMS Wrkspace\\Customer Quality Monthly Analysis Reports
#'
#' @param slide_df A dataframe containing MicroSlide sales data. See \link[srms]{clsales_reader}.
#' @param tip_df A dataframe containing MicroTip sales data. See \link[srms]{clsales_reader}.
#' @param well_df A dataframe containing MicroWell sales data. See \link[srms]{clsales_reader}.
#' @param dt_df A dataframe containing DT sales data. See \link[srms]{clsales_reader}.
#' @param write Defaults to TRUE. Will write results to excel file if TRUE.
#' @param xlsxfile Name of Excel Workbook if write = TRUE. Defaults to CL_Sales_DDMMMYYYY.xlsx
#' where DDMMYYYY is the day, abbreviated month label, and the year.
#'
#' @return Returns a list of dataframes which contain sales data for each Technology.
#'
#' @export

clsales_parser <- function(
  slide_df,
  tip_df,
  well_df,
  dt_df,
  write = TRUE,
  xlsxfile = NA
) {

  # point to zip directory for file writing
  # Sys.setenv(R_ZIPCMD = 'C:/Rtools/bin/zip')

  techs <- c('Microslide', 'MicroTip', 'MicroWell', 'DT')

  # create columns headers for excel sheets
  months <- c('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
              'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec')

  # last year as well as current year mmm-yyyy
  headers <- c(
    paste(months, lubridate::year(Sys.time()) - 2, sep = '-'),
    paste(months, lubridate::year(Sys.time()) - 1, sep = '-'),
    paste(months, lubridate::year(Sys.time()), sep = '-')
  )

#   default_header <- c('Material_Code', 'Product_Desc', 'Region',
#                       'Country.Code1', 'Country.Code2', 'Grouped')
  default_header <- c('Material_Code', 'Product_Desc')

  # split first column of slide dataframe for material code and product desc
#   x <- strsplit(slide_df$X1, ' \\| ')
#   slide_df$Material_Code <- unlist(lapply(x, function(x) x[1]))
#   slide_df$Product_Desc <- unlist(lapply(x, function(x) x[2]))

  # parse microslide data
#   names(slide_df)[2:5] <- c('Region', 'Country.Code1',
#                             'Country.Code2', 'Grouped')
  names(slide_df)[1:2] <- default_header

  # slide_df <- slide_df[, -1]
  # mask <- (1:ncol(slide_df))[!(grepl('Total', names(slide_df)))]
  mask <- c(1, 2, (1:ncol(slide_df))[!is.na(as.numeric(names(slide_df)))])
#   slide_df <- slide_df[, mask]
#   slide_df[, 5:(ncol(slide_df)-2)] <- lapply(
#     slide_df[, 5:(ncol(slide_df)-2)],
#     as.numeric
#   )
  slide_df <- slide_df[, mask]
  slide_df[, 3:ncol(slide_df)] <- lapply(
    slide_df[, 3:ncol(slide_df)],
    as.numeric
  )

  # parse microtip data
  names(tip_df)[1:2] <- default_header
  mask <- c(1, 2, (1:ncol(tip_df))[!is.na(as.numeric(names(tip_df)))])
  tip_df <- tip_df[, mask]
  tip_df[, 3:ncol(tip_df)] <- lapply(tip_df[, 3:ncol(tip_df)], as.numeric)

  # parse microwell data
  names(well_df)[1:2] <- default_header
  mask <- c(1, 2, (1:ncol(well_df))[!is.na(as.numeric(names(well_df)))])
  well_df <- well_df[, mask]
  well_df[, 3:ncol(well_df)] <- lapply(well_df[, 3:ncol(well_df)], as.numeric)

  # parse DT data
  names(dt_df)[1:2] <- default_header
  mask <- c(1, 2, (1:ncol(dt_df))[!is.na(as.numeric(names(dt_df)))])
  dt_df <- dt_df[, mask]
  dt_df[, 3:ncol(dt_df)] <- lapply(dt_df[, 3:ncol(dt_df)], as.numeric)

  # function to aggregate sales data my material code
  grouper <- . %>%
#     dplyr::select(
#       -Region,
#       -Country.Code1,
#       -Country.Code2,
#       -Grouped
#     ) %>%
    dplyr::group_by(
      Material_Code,
      Product_Desc
    ) %>%
    dplyr::summarise_each(
      dplyr::funs(sum)
    )

  slide_df %<>% grouper()
  tip_df %<>% grouper()
  well_df %<>% grouper()
  dt_df %<>% grouper()

  names(slide_df)[3:ncol(slide_df)] <- headers
  names(tip_df)[3:ncol(tip_df)] <- headers
  names(well_df)[3:ncol(well_df)] <- headers
  names(dt_df)[3:ncol(dt_df)] <- headers

  ind <- match(
    paste(lubridate::month(Sys.time(), label = TRUE, abbr= TRUE),
          lubridate::year(Sys.time()),
          sep = '-'),
    headers
  )
  slide_df[, (ind+2):ncol(slide_df)] <- 0
  tip_df[, (ind+2):ncol(tip_df)] <- 0
  well_df[, (ind+2):ncol(well_df)] <- 0
  dt_df[, (ind+2):ncol(dt_df)] <- 0

  df_list <- list(
    MicroSlide = slide_df,
    MicroTip = tip_df,
    MicroWell = well_df,
    DT = dt_df
  )

  if (write) {
    if (is.na(xlsxfile)) {
      time <- time_vals()
      xlsxfile <- paste0(
        'CL_Sales_',
        time$day,
        lubridate::month(as.numeric(time$month), label = TRUE),
        time$year,
        '.xlsx'
      )
    }

    wb <- openxlsx::createWorkbook()

    for (tech in techs) {
      openxlsx::addWorksheet(
        wb = wb,
        sheetName = paste(tech, 'Sales')
      )

      openxlsx::writeDataTable(
        wb = wb,
        sheet = paste(tech, 'Sales'),
        x = df_list[[match(tech, techs)]],
        withFilter = FALSE,
        tableStyle = 'TableStyleLight15'
      )
    }

    openxlsx::saveWorkbook(
      wb = wb,
      file = xlsxfile,
      overwrite = TRUE
    )
  }

  return(df_list)
}
kimjam/srms documentation built on May 20, 2019, 10:21 p.m.