R/import_fn_creel1.R

Defines functions import_fn_creel

Documented in import_fn_creel

#' import_fn_creel
#' @description A generic import function similar to open.fn.data1 but for creel files.  
#' Project path build is omitted so it must be provided in file path. The function
#' will import the following tables: FN011, FN012, FN022, FN023, FN024, 
#' FN025, FN026, FN028, FN111, FN112, FN121, FN123, FN124, FN125, FN126,
#'  and FN127.
#' @param generic_datazip File path to FN DATA.ZIP folder for a creel project
#' @returns Function returns a list of FN tables. If a table is not included
#' in the FN project an empty data frame will still be returned as well as 
#' a `usethis` message during import.
#' @export

import_fn_creel <- function(generic_datazip) {
  # check that only 1 file is provided
  if(length(generic_datazip)!=1) {
    usethis::ui_stop('This function can only import a single file')
    break
  }
  
  # check that the file exists
  if(file.exists(generic_datazip)) {
    usethis::ui_done("File exists")
  } else {
    usethis::ui_stop("File not found. Check file path.")
  }
  
  # check that a DATA.ZIP file has been provided
  has_zip <- grep(generic_datazip, pattern = "DATA\\.ZIP$")
  if(length(has_zip) == 1) {
    usethis::ui_done("DATA.ZIP input accepted")
  } else {
    usethis::ui_stop("Input file expects a DATA.ZIP file")
  }
  
  AllTables <- c("FN011", "FN012", "FN022", "FN023", "FN024", "FN025", "FN026", "FN028", "FN111", 
                  "FN112", "FN121", "FN123", "FN124", "FN125", "FN126", "FN127")
  
  # Create and unzip data to a temp file
  mytemp <- tempdir()
  unzip(generic_datazip, exdir = mytemp)
  
  # check each table exists
  check_table <- function(fntable){
    mydbf <- paste(fntable, ".DBF", sep = "")
    table_exists <- mydbf %in% dir(mytemp)
    table_exists
  }
  
  import_table <- function(fntable) {
    table_exists <- check_table(fntable)
    if(table_exists) {
      usethis::ui_done(paste0(fntable, " available for import"))
      mydbf <- paste(fntable, ".DBF", sep = "")
      mypaths <- file.path(mytemp, mydbf)
      rawdata <- foreign::read.dbf(mypaths, as.is = T)
      return(rawdata)
    } else {
      usethis::ui_oops(paste0(fntable, " is not available for import"))
    }
  }
  
  alldata <- lapply(AllTables, import_table)
  
  names(alldata) <- AllTables
  
  usethis::ui_done("Data has been imported with each table as a list.")
  
  # clean up temp files
  unlink(mytemp)
  
  # remove V0 and ENTRY from all tables
  remove_V0 <- function(tbl_list) {
    lapply(tbl_list, function(df) {
      if ("V0" %in% colnames(df)) {
        df <- df[, !colnames(df) %in% "V0", drop = FALSE]
      }
      df
    })
  }
  
  remove_entry <- function(tbl_list) {
    lapply(tbl_list, function(df) {
      if ("ENTRY" %in% colnames(df)) {
        df <- df[, !colnames(df) %in% "ENTRY", drop = FALSE]
      }
      df
    })
  }
  
  alldata <- remove_V0(alldata)
  alldata <- remove_entry(alldata)
  
  # return final data
  alldata
  
}
HoldenJe/gfsR documentation built on Nov. 19, 2024, 5:06 p.m.