R/LP-class.R

Defines functions LoanPerformanceDataset

#' @import fst
setOldClass("fst_table")

#' LoanPerformanceDataset
#'
#' A \code{\link[fst]{fst}} dataset containing monthly updates of loan attributes.
#'
##' @family Loan Level Datasets
#' @name LoanPerformanceDataset-class
#' @slot from_date first reporting month period
#' @slot to_date last reporting month period
#' @slot OrigYr year of origination of the loans
#' @slot path path to the \code{\link[fst]{fst}} file.
#' @slot file_txt path to the text data file
#' @slot Data_A_path path to the associated text data file containing origination information of the loans
#'
#' @import methods
#' @exportClass LoanPerformanceDataset
#' @export
#'
setClass("LoanPerformanceDataset", contains ="fst_table",
         slots  = c(from_date="Date", to_date="Date", OrigYr="integer", path="character",  file_txt="character", Data_A_path="character"))

#' LoanPerformanceDataset constructor
#'
#'
#' @param OrigYr integer Loans Origination Year (1999 to 2019)
#' @param perf_txt character data file to parse
#' @param verbose logical
#'
#' @return object LoanPerformanceDataset
#' @importFrom fst read_fst write_fst
#' @export
LoanPerformanceDataset <- function(OrigYr,perf_txt,verbose=FALSE) {
  # browser()
  if(missing(perf_txt)) {
    if(missing(OrigYr)) stop("OrigYr not defined")
    OrigYr <- as.integer(OrigYr)
    stopifnot(OrigYr %in% seq.int(1999,2019))

    Data_P_fst <- file.path(fn_llp_workdir, sprintf("Data_P_%d.fst", OrigYr))
    if( !file.exists(Data_P_fst)) {
      stop(paste(Data_P_fst, "not found\n"))
    }

    Data_A_path <- file.path(fn_llp_workdir, sprintf("Data_A_%d.fst", OrigYr))
    if( !file.exists(Data_A_path)) {
      stop(paste(Data_A_path, "not found\n"))
    }
    fst_table <- fst(Data_P_fst)
    return(new("LoanPerformanceDataset", fst_table, OrigYr=OrigYr,
               from_date=as.Date(min(fst_table$Monthly.Rpt.Prd)),
               to_date=as.Date(max(fst_table$Monthly.Rpt.Prd)),
               path=Data_P_fst, Data_A_path=Data_A_path))
  } else {
    Data_P <- process_P(perf_txt, verbose = verbose)
    Data_P_fst <-tempfile("Data_P_", fileext = ".fst")
    write_fst(Data_P, Data_P_fst)
    fst_table <- fst(Data_P_fst)
    return(new("LoanPerformanceDataset", fst_table, OrigYr=NA_integer_,
               from_date=as.Date(min(fst_table$Monthly.Rpt.Prd)),
               to_date=as.Date(max(fst_table$Monthly.Rpt.Prd)),
               path=Data_P_fst, file_txt=perf_txt))
  }

}

#' show
#'
#' @param object LoanPerformanceDataset.
#'
#' @export
#'
setMethod("show", signature(object = "LoanPerformanceDataset"), function(object) {
  cat("Orig Year",  object@OrigYr, "\n")
  cat(length(unique(object$LOAN_ID)), "unique loans\n")
print(metadata_fst(object@path))
})

#' @import data.table
#' @importFrom fst fst read_fst
setMethod("subset", signature(x = "LoanPerformanceDataset"), function(x, subset=NULL, select=NULL, drop=FALSE, ...) {
  # browser()

  Data_P <- read_fst(x@path, columns=select, as.data.table = TRUE)

  if(is.expression(subset)) {
    Data_A_fst <- fst(x@Data_A_path)
    Data_A_cols <- c('LOAN_ID', names(Data_A_fst)[sapply(names(Data_A_fst), function(pattern) grepl(pattern,as.character(subset)))])
    Data_A <- read_fst(x@Data_A_path, columns = Data_A_cols,  as.data.table = TRUE)
    i <- eval(subset, envir = Data_A)
    Data_A <- subset(Data_A, subset=i)

    retval <- Data_P[Data_A, nomatch=NULL]
    return(retval)
  } else {
    return(Data_P)
  }
})


# setMethod("as.data.table", signature(x = "LoanPerformanceDataset"), function(x, columns=NULL) {
#
#   return(Data_P)
# })
canarionyc/loanroll documentation built on Sept. 7, 2020, 4:50 a.m.