R/csv_conversion_wrapper.R

In PAHPLabResearch/FLASH: FLASH: Free Living Activity Study for Health

#' @rdname csv_conversion_wrapper
#' @keywords internal
create_button_call <- function(
  window, button_name, text, width = 70
) {
  window_name <- deparse(substitute(window))
  paste(
    window_name, "$env$",
    button_name, " <- tcltk2::tk2checkbutton(",
    window_name,
    ", text = \"", text, "\"",
    ", width = ", width,
    ")", sep = ""
  )
}

#' @rdname csv_conversion_wrapper
#' @keywords internal
select_folders_to_convert <- function(rds_files) {

  message(paste(
    "A window should have popped up. If you don\'t see it,",
    "\n   check your",
    "toolbar to see if it opened without popping up.\n"
  ))

  window <- tcltk::tktoplevel(width = 600)
  tcltk::tktitle(window) <- "Select data folder(s) to convert to csv"
  done <- tcltk::tclVar(0)

  for (x in rds_files) {
    paste0(x$dir, " ------- ", x$nfiles, " file(s)") %>%
    create_button_call(
      window,
      x$name,
      .
    ) %>%
    {eval(parse(text = .))}
    assign(x$name, tcltk::tclVar("0"))
    tcltk::tkconfigure(window$env[[x$name]], variable = get(x$name))
    tcltk::tkgrid(window$env[[x$name]], pady = 1.5, padx = 75)
  }

  window$env$OK <- tcltk2::tk2button(
    window, text = "OK", width = -6,
    command = function() {
      tcltk::tclvalue(done) <- 2
    }
  )
  tcltk::tkgrid(window$env$OK, padx = 75, pady = c(0, 1.5))

  tcltk::tkbind(
    window,"<Destroy>",
    function() tcltk::tclvalue(done) <- 1
  )

  ## Pause script while box is processed
  repeat{if(tcltk::tclvalue(done)!='0') break}

  if (tcltk::tclvalue(done) == "1") {
    stop(
      paste(
        "Can\'t complete this script if you",
        "don\'t fill in the form. Try again."
      )
    )
  }

  tcltk::tkdestroy(window)

  rds_files %>%
  sapply(function(x) {
    get(x$name) %>%
    {tcltk::tclvalue(.) == 1}
  }) %>%
  rds_files[.] %T>%
  {if (!length(.)) stop(
    "No files selected. Stopping script. Try again."
  )}

}

#' @rdname csv_conversion_wrapper
#' @keywords internal
folder_convert <- function(rds_files) {

  {stopifnot(identical(
    names(rds_files),
    c("files", "dir", "name", "nfiles")
  ))}

  message(
    "\nConverting ", rds_files$nfiles, " file(s)",
    " in the ", rds_files$dir, " folder"
  )

  for(i in seq(rds_files$files)) {

    (i / rds_files$nfiles * 100) %>%
    {paste0(round(.,0), "%")} %>%
    cat("\r", ., "     ")

    rds_files$files[i] %>%
    readRDS(.) %>%
    sapply(as.character) %>%
    data.frame(stringsAsFactors = FALSE) %>%
    data.table::fwrite(
      gsub("rds$", "csv", rds_files$files[i])
    )

    if (i == rds_files$nfiles) cat("\rCOMPLETE! ")

  }

  invisible()

}

#' Interactively select folders of rds data to convert to csv
#'
#' @param rds_files an internal object with information about existing rds files
#' @param window a window from tcltk
#' @param button_name character. Name for the button, most likely identical to
#'   the value for \code{text}
#' @param text character. Text for the button label
#' @param width numeric. Width for the window
csv_conversion_wrapper <- function() {

  list.files(
    "data-raw",
    "rds$",
    full.names = TRUE,
    recursive = TRUE
  ) %>%
  split(., dirname(.)) %>%
  lapply(function(x) {
    list(
      files = x,
      dir = {
        dirname(x) %>%
        unique(.)
      },
      name = {
        dirname(x) %>%
        unique(.) %>%
        gsub("/rds$", "", .) %>%
        gsub("-*", "", .) %>%
        basename(.)
      },
      nfiles = length(x)
    )
  }) %>%
  select_folders_to_convert(.) %>%
  lapply(folder_convert) %>%
  invisible(.)

}